XL 2016 Filtre vba avec critères dans une plage

[counterbob]

Bonjour
ma question est peut-on réaliser un filtre automatique avec comme valeurs dans Criteria1 une plage de cellule d'une autres feuille ?
J'ai enregistré cette macro qui se lance grâce à une case option.

ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=Array( "INF1", "MED1", "MED2"), Operator:=xlFilterValues

mais les valeurs sont variables dans la plage
Je pose un fichier exemple.
Merci pour piste
@+

 

[Compte Supprimé 979]

Bonsoir CounterBob

Avec un petit tableau structuré pour les critères et un petit code dans le module

Option Explicit

Dim TabCrit

Sub Filtre1()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre1]"))
  ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Sub Filtre2()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre2]"))
  ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Sub Filtre3()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre3]"))
  ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Voici

 

[counterbob]

Bonsoir CounterBob

Avec un petit tableau structuré pour les critères et un petit code dans le module

Option Explicit

Dim TabCrit

Sub Filtre1()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre1]"))
  ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Sub Filtre2()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre2]"))
  ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Sub Filtre3()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre3]"))
  ActiveSheet.Range("$A$1:$F$201").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Voici

Wouah !!!
Vous êtes incroyable.
Merci beaucoup.
Juste une dernière question: si la plage ("$A$1:$F$201") augmente le filtre la pend-elle en considération ?

 

[Compte Supprimé 979]

Re,

Non, il faut faire la même chose, un tableau structuré et faire référence à la colonne de ce TS

 

[counterbob]

Re,

Non, il faut faire la même chose, un tableau structuré et faire référence à la colonne de ce TS

Ok Merci
bonne soirée

 

[laurent950]

Bonsoir @counterbob , @BrunoM45

J'ai fait le code sur une autre discussion, c'est sur le même principe.

J'ai corrigé les 2 Postes # 45 et #47
J'ai ajouté les filtres
Même code : "RdV Fait Annulé" Poste #47 Ou "RdV Fait" Poste #45

Microsoft 365 - CurrentRegion : sélection de cellules

Bonjour à toutes et à tous, Je vous souhaite une belle et chaude journée :) Je n'arrive pas à adapter un code que Job75 m'a donné. Le code était(pour appliquer une formule) : Code origine Gérard Sheets("Comptage_appels").Select ActiveSheet.Unprotect Password:="" With [a1].CurrentRegion...

www.excel-downloads.com

Je corrige votre code si vous arrivez pas à le retranscrire

Laurent

 

[laurent950]

Bonsoir @counterbob

Le code est fait selon votre demande
Worksheets("BD").Range("$A$1:$F$201")
soit
Juste une dernière question: si la plage ("$A$1:$F$201") augmente le filtre la pend-elle en considération ? = Oui
Worksheets("BD").Range(Worksheets("BD").cells(1,1),Worksheets("BD").cells(Worksheets("BD").cells(65536,1).end(xlup).row,6))

Jussqu'à la ligne 65536, de la colonne 1 (A adapter pour plus de lignes)

Sub Filtre1()
' Filtre1 Macro
   Dim FBD, FFiltre As Worksheet
   Set FBD = Worksheets("BD")
   Set FFiltre = Worksheets("Filtre")
   Dim Rgn As Range
   Set Rgn = FFiltre.Range(FFiltre.Cells(2, 2), FFiltre.Cells(4, 2))
   Dim TabArray As Variant
   TabArray = Application.Transpose(Rgn.Value2)
   FBD.Range(FBD.Cells(1, 1), FBD.Cells(FBD.Cells(65536, 1).End(xlUp).Row, 6)).AutoFilter Field:=6, Criteria1:=TabArray, Operator:=xlFilterValues
End Sub

Sub Filtre2()
' Filtre2 Macro
   Dim FBD, FFiltre As Worksheet
   Set FBD = Worksheets("BD")
   Set FFiltre = Worksheets("Filtre")
   Dim Rgn As Range
   Set Rgn = FFiltre.Range(FFiltre.Cells(2, 3), FFiltre.Cells(5, 3))
   Dim TabArray As Variant
   TabArray = Application.Transpose(Rgn.Value2)
   FBD.Range(FBD.Cells(1, 1), FBD.Cells(FBD.Cells(65536, 1).End(xlUp).Row, 6)).AutoFilter Field:=6, Criteria1:=TabArray, Operator:=xlFilterValues
End Sub

Sub Filtre3()
' Filtre3 Macro
   Dim FBD, FFiltre As Worksheet
   Set FBD = Worksheets("BD")
   Set FFiltre = Worksheets("Filtre")
   Dim Rgn As Range
   Set Rgn = Worksheets("Filtre").Range(Worksheets("Filtre").Cells(2, 4), Worksheets("Filtre").Cells(7, 4))
   Dim TabArray As Variant
   TabArray = Application.Transpose(Rgn.Value2)
   FBD.Range(FBD.Cells(1, 1), FBD.Cells(FBD.Cells(65536, 1).End(xlUp).Row, 6)).AutoFilter Field:=6, Criteria1:=TabArray, Operator:=xlFilterValues
End Sub

 

[Compte Supprimé 979]

Bonjour Laurent950

Tellement inutile toutes ces lignes de codes pour un simple filtre sur un tableau structuré
Pensez-y ça existe depuis Excel2007 quand même

Dim TabCrit

Sub Filtre1()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre1]"))
  ActiveSheet.Range("TabBD[Grade]").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Sub Filtre2()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre2]"))
  ActiveSheet.Range("TabBD[Grade]").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

Sub Filtre3()
  TabCrit = Application.Transpose(Range("Tableau1[Filtre3]"))
  ActiveSheet.Range("TabBD[Grade]").AutoFilter Field:=6, Criteria1:=TabCrit, Operator:=xlFilterValues
End Sub

A+