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

[Appo1985]

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.

 

[chris]

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

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...

 

[chris]

RE

Une autre approche, en saisissant le ou les critères souhaités dans la zone N2:X3

Autre approche, pas vraiment puisque c'est aussi un filtre avancé mais ne gérant pas les tableaux structurés...

 

[Appo1985]

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

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...

Merci bien @chris pour votre réponse.

Cependant je voudrais encore comprendre. Que signifie ThisWorkbook.Sheets ("données").Range("P1😛2") 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.

 

[Appo1985]

RE

Autre approche, pas vraiment puisque c'est aussi un filtre avancé mais ne gérant pas les tableaux structurés...

Merci bien @chris pour votre réponse.

Cependant je voudrais encore comprendre. Que signifie ThisWorkbook.Sheets ("données").Range("P1😛2") 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.

 

[Appo1985]

Merci bien @chris pour votre réponse.

Cependant je voudrais encore comprendre. Que signifie ThisWorkbook.Sheets ("données").Range("P1😛2") 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.

Il y a un signe qui s'inssere automatiquement dans ma réponse à la place des deux points

 

[chris]

RE

Si tu regardes le fichier que j'ai joint tu vois sur l'onglet des inscriptions les deux cellules P1: P2 qui servent de critères et où tu peux remplacer Masculin par Féminin...

 

[Appo1985]

RE

Si tu regardes le fichier que j'ai joint tu vois sur l'onglet des inscriptions les deux cellules P1😛2 qui servent de critères et omù tu peux remplacer Masculin par Féminin...

Merci bien. J'ai pu remplacer et ça marche. Je voudrais maintenant trier pas ordre alphabétique. Merci

 

[chris]

RE

Ordre alpha de quelle(s) colonne(s) ?

 

[Appo1985]

RE

Ordre alpha de quelle(s) colonne(s) ?

Au niveau de la colonne Nom

 

[chris]

RE

Remplace la 1ère Sub par

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

 

[Appo1985]

RE

Remplace la 1ère Sub par

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

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

 

[chris]

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

 

[mapomme]

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:

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

 

[mapomme]

Re,

Préférer la v2 (correction d'un bogue quand le tableau structuré est en mode Autofilter avec filtres actifs).