XL 2016 Filtre vba avec critères dans une plage

counterbob

XLDnaute Nouveau
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
@+
 

Pièces jointes

  • listenom.xlsm
    32.7 KB · Affichages: 11
C

Compte Supprimé 979

Guest
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 ;)
 

Pièces jointes

  • CounterBob_listenom.xlsm
    34.7 KB · Affichages: 28

counterbob

XLDnaute Nouveau
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 ?
 

laurent950

XLDnaute Accro
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


Je corrige votre code si vous arrivez pas à le retranscrire

Laurent
 
Dernière édition:

laurent950

XLDnaute Accro
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
 
Dernière édition:
C

Compte Supprimé 979

Guest
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+
 

Pièces jointes

  • CounterBob_listenom.xlsm
    35.5 KB · Affichages: 33

Discussions similaires

Statistiques des forums

Discussions
311 710
Messages
2 081 781
Membres
101 817
dernier inscrit
carvajal