XL 2013 Filtrage de données d'un tableau sur une autre feuille

A

Appo1985

XLDnaute Occasionnel
Bonjour à tous
J'ai besoin d'aide pour réaliser un filtre de mes données qui sont sur le tableau "Inscription" se trouvant sur la feuille"données" au niveau du tableau nommé"Filtre" de la feuille"liste".
Je voulais filtrer la colonne Sexe c'est à dire Masculin et Féminin.
Merci d'avance.
 

Pièces jointes

  • exercice filtre.xlsx
    11.1 KB · Affichages: 25
Trier par date Trier par votes
chris

chris

XLDnaute Barbatruc
Bonjour

On peut passer par un filtre avancé automatisé

La 1ère sub fournit la plage de critères et le nom des tableaux à la seconde qui est générique

VB: 
Option Explicit
Sub FiltreT()
'Initialisation + appel du filtre d'un tableau structuré vers un autre

    Dim ZCriteres As Range
  
    Set ZCriteres = ThisWorkbook.Sheets("données").Range("P1:P2")
    Call FiltreTableau("Inscription", "Filtre", ZCriteres)

End Sub

Sub FiltreTableau(TabS_Nom As String, TabD_Nom As String, ByVal ZCriteres As Range)
'filtre d'un tableau structuré vers un autre

  
    Dim ZDest As Range, TRange As Range
    Dim Tableau As ListObject, TDest As ListObject
    Dim x1 As Integer, y2 As Long, LargeurT As Integer, HauteurT As Long
  
    Set TDest = Range(TabD_Nom).ListObject
    Set ZDest = TDest.HeaderRowRange
    Set Tableau = Range(TabS_Nom).ListObject
    Set TRange = Tableau.Range
  
  
    With TDest
        LargeurT = .ListColumns.Count
        If .ListRows.Count > 0 Then .DataBodyRange.ClearContents
        .Resize .Range.Resize(3, LargeurT)
        TRange.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=ZCriteres, _
            CopyToRange:=ZDest, Unique:=False
        x1 = .Range.Column
        y2 = .Parent.Cells(Cells.Rows.Count, x1).End(xlUp).Row
        HauteurT = y2 - .Range.Row + 1
        .Resize .Range.Resize(HauteurT, LargeurT)
        .Parent.Range("" & x1 & ":" & x1 + LargeurT - 1 & "").EntireColumn.AutoFit
    End With
End Sub

Je te laisse le soin d'ajouter un bouton ou une macro évenementielle liée au changement de critères...
 

Pièces jointes

  • Tableau_Filre.xlsm
    24 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
A

Appo1985

XLDnaute Occasionnel
chris à dit:
Bonjour

On peut passer par un filtre avancé automatisé

La 1ère sub fournit la plage de critères et le nom des tableaux à la seconde qui est générique

VB: 
Option Explicit
Sub FiltreT()
'Initialisation + appel du filtre d'un tableau structuré vers un autre

    Dim ZCriteres As Range
 
    Set ZCriteres = ThisWorkbook.Sheets("données").Range("P1:P2")
    Call FiltreTableau("Inscription", "Filtre", ZCriteres)

End Sub

Sub FiltreTableau(TabS_Nom As String, TabD_Nom As String, ByVal ZCriteres As Range)
'filtre d'un tableau structuré vers un autre

 
    Dim ZDest As Range, TRange As Range
    Dim Tableau As ListObject, TDest As ListObject
    Dim x1 As Integer, y2 As Long, LargeurT As Integer, HauteurT As Long
 
    Set TDest = Range(TabD_Nom).ListObject
    Set ZDest = TDest.HeaderRowRange
    Set Tableau = Range(TabS_Nom).ListObject
    Set TRange = Tableau.Range
 
 
    With TDest
        LargeurT = .ListColumns.Count
        If .ListRows.Count > 0 Then .DataBodyRange.ClearContents
        .Resize .Range.Resize(3, LargeurT)
        TRange.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=ZCriteres, _
            CopyToRange:=ZDest, Unique:=False
        x1 = .Range.Column
        y2 = .Parent.Cells(Cells.Rows.Count, x1).End(xlUp).Row
        HauteurT = y2 - .Range.Row + 1
        .Resize .Range.Resize(HauteurT, LargeurT)
        .Parent.Range("" & x1 & ":" & x1 + LargeurT - 1 & "").EntireColumn.AutoFit
    End With
End Sub

Je te laisse le soin d'ajouter un bouton ou une macro évenementielle liée au changement de critères...
Cliquez pour agrandir...
Merci bien @chris pour votre réponse.

Cependant je voudrais encore comprendre. Que signifie ThisWorkbook.Sheets ("données").Range("P1:p2") dans ce code.

Quelle adaptation puis je faire si la plage de critères est nommée "Masculin"

Que dois-je faire si je veux trier en même temps par ordre alphabétique ?
Merci.
 
Vote positif 0 Vote négatif
A

Appo1985

XLDnaute Occasionnel
chris à dit:
RE

Autre approche, pas vraiment puisque c'est aussi un filtre avancé mais ne gérant pas les tableaux structurés...
Cliquez pour agrandir...
Merci bien @chris pour votre réponse.

Cependant je voudrais encore comprendre. Que signifie ThisWorkbook.Sheets ("données").Range("P1:p2") dans ce code.

Quelle adaptation puis je faire si la plage de critères est nommée "Masculin"

Que dois-je faire si je veux trier en même temps par ordre alphabétique ?
Merci.
 
Vote positif 0 Vote négatif
A

Appo1985

XLDnaute Occasionnel
Appo1985 à dit:
Merci bien @chris pour votre réponse.

Cependant je voudrais encore comprendre. Que signifie ThisWorkbook.Sheets ("données").Range("P1:p2") dans ce code.

Quelle adaptation puis je faire si la plage de critères est nommée "Masculin"

Que dois-je faire si je veux trier en même temps par ordre alphabétique ?
Merci.
Cliquez pour agrandir...
Il y a un signe qui s'inssere automatiquement dans ma réponse à la place des deux points
 
Vote positif 0 Vote négatif
chris

chris

XLDnaute Barbatruc
RE

Remplace la 1ère Sub par
VB: 
Sub FiltreT()
'Initialisation + appel du filtre d'un tableau structuré vers un autre

    Dim ZCriteres As Range
    
    Set ZCriteres = ThisWorkbook.Sheets("données").Range("P1:P2")
    Call FiltreTableau("Inscription", "Filtre", ZCriteres)
    
    With Range("Filtre").ListObject
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 _
    Key:=Range("Filtre[Nom]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortTextAsNumbers
    With .Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End With

End Sub
 
Vote positif 0 Vote négatif
A

Appo1985

XLDnaute Occasionnel
chris à dit:
RE

Remplace la 1ère Sub par
VB: 
Sub FiltreT()
'Initialisation + appel du filtre d'un tableau structuré vers un autre

    Dim ZCriteres As Range
   
    Set ZCriteres = ThisWorkbook.Sheets("données").Range("P1:P2")
    Call FiltreTableau("Inscription", "Filtre", ZCriteres)
   
    With Range("Filtre").ListObject
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 _
    Key:=Range("Filtre[Nom]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortTextAsNumbers
    With .Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End With

End Sub
Cliquez pour agrandir...
Bonjour. Après avoir remplacé un messa d'erreur s'affiche disant: <<Propriété ou méthode non géré par cet objet>>. Je ne sais pas comment résoudre ce problème. Merci.
Ci joint le capture
 

Pièces jointes

  • image erreur 2.png
    image erreur 2.png
    23.2 KB · Affichages: 17
  • image erreur1.png
    image erreur1.png
    25.5 KB · Affichages: 16
Vote positif 0 Vote négatif
chris

chris

XLDnaute Barbatruc
Bonjour

Ton cas réel est-il bien conforme à l'exemple ?

Ci-joint le fichier modifié comme indiqué

J'ai ajouté un plus une liste déroulante pour le choix du sexe et l'extraction automatique dès que le choix change.

A noter que sur 2013 tu pourrais ajouter l'add on PowerQuery (intgéré à EXcel à partir de 2016) et simplifier tout cela par une requête
 

Pièces jointes

  • Tableau_Filre.xlsm
    26.6 KB · Affichages: 5
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à @Appo1985 :), bonjour @chris ;),

Comme j'avais du temps à tuer, j'ai utilisée une autre méthode que le filtre (tableau en mémoire)
J'ai commenté tout le code.

La mise à jour de l'extraction sur la feuille "liste" se fait:
  • à l'ouverture du fichier
  • au changement de critère sur la feuille "liste" - cellule G9 que l'on a nommée "Genre"
  • à l'activation de la feuille "liste"
Il y a donc un peu de code:
  • dans le module de ThisWorkbook (ouverture du classeur)
  • dans le module de la feuille "liste" (changement de genre désiré et activation de la feuille)
  • et bien sûr dans module1, on trouve la procédure principale (brute et aussi commentée)
Le code dans module1:
VB: 
Sub FiltrerTrier()
Dim t, Critere As String, n&, i&, j&
   On Error GoTo FIN
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   Critere = Replace(Left(Range("genre"), 1), "T", "") & "*"
   t = Sheets("données").ListObjects(1).DataBodyRange.Columns("a:f")
   For i = 1 To UBound(t)
      If UCase(t(i, 6)) Like Critere Then n = n + 1: For j = 2 To UBound(t, 2): t(n, j) = t(i, j): Next
   Next i
   With Sheets("liste").ListObjects(1)
      If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
      If Not n = 0 Then
         .Range(2, 1).Resize(n, UBound(t, 2)) = t
         .Range.Sort key1:=.ListColumns(2), order1:=xlAscending, Header:=xlYes, key2:=.ListColumns(3), order2:=xlAscending
      End If
   End With
FIN:
   Application.EnableEvents = True: Beep
End Sub
 

Pièces jointes

  • Appo1985-filtre-v1.xlsm
    28.2 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

treza88
  • Question
XL 2021 Dernière ligne rempli d'un tableau de données filtrées
Réponses
5
Affichages
318
treza88
treza88
S
  • Question
Autres liste déroulante dynamique à 2 niveaux
Réponses
2
Affichages
114
saralht
S
A
  • Résolu(e)
XL 2019 VBA - Copie données selon 3 critères
Réponses
4
Affichages
274
abouilies
A
Phil Du59
  • Résolu(e)
Microsoft 365 Tableau de STATS sur autre feuille
Réponses
8
Affichages
334
AtTheOne
AtTheOne
G
  • Question
Autres TCD nouvelles données non visible
Réponses
9
Affichages
496
Gaëlle excel
G
O
  • Question
XL 2019 Formulaire vba pour filtrer les données
Réponses
7
Affichages
462
olivier1984
O
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
430
steph_29120
S
C
  • Résolu(e)
XL 2021 filtrer données puis envoi sur une autre feuille
Réponses
3
Affichages
496
sylvanu
sylvanu
M
  • Question
XL 2021 Avoir des tableaux liés à une base de données
2
Réponses
24
Affichages
472
Nain porte quoi
N
Z
  • Question
Microsoft 365 Segment commun avec plusieurs onglets source de données
Réponses
12
Affichages
563
Zazagally
Z

Membres actuellement en ligne

9 membres et 111 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 168
Messages
2 116 925
Membres
112 916
dernier inscrit
jujhu90