XL 2016 Filtre vba avec critères dans une plage

counterbob · 8 Décembre 2021

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 · 8 Décembre 2021

Bonsoir CounterBob

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

VB:

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 · 8 Décembre 2021

BrunoM45 à dit:

Bonsoir CounterBob

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

VB:

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 · 8 Décembre 2021

Re,

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

counterbob · 8 Décembre 2021

BrunoM45 à dit:
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 · 8 Décembre 2021

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 · 8 Décembre 2021

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)

VB:

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

VB:

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

VB:

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 · 9 Décembre 2021

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

VB:

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+

XL 2016 Filtre vba avec critères dans une plage

counterbob

XLDnaute Nouveau

Pièces jointes

Compte Supprimé 979

Guest

Pièces jointes

counterbob

XLDnaute Nouveau

Compte Supprimé 979

Guest

counterbob

XLDnaute Nouveau

laurent950

XLDnaute Accro

Microsoft 365 - CurrentRegion : sélection de cellules

laurent950

XLDnaute Accro

Compte Supprimé 979

Guest

Pièces jointes

Discussions similaires