Question récurrente s'il en est, le filtre multi-critères

La solution proposée dispense d'une recherche avec Find, d'une boucle sur les lignes, et permet de filtrer un nombre de colonnes limité... au nombre de colonnes d'une feuille de calculs.

Aucune sélection de colonne, de plage de données ou de feuille n'est nécessaire.

Dans l'exemple, les colonnes 1, 4, 6 et 8 seront filtrées selon les critères 1 à 4
Les N° de colonnes sont placés dans un premier tableau, les critères dans un second.

Enfin une option de copie de la plage filtrée sur "feuil2" est proposée.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
 
Sub FiltreMultiCritere_Methode2()
Dim FL1 As Worksheet 'La feuille de calculs
Dim DerCol As String, NoCol As Integer
Dim Criteres As Variant, Colonnes As Variant
 
Dim Plage As Range 'utiles si Option de copie désirée
 
    '**************** LIGNES A ADAPTER à SON PROJET ********************************************
        'Les critères de recherche
        Criteres = Array("", "CC MARIE CURIE", "1001", "60", "25")
        Colonnes = Array("", 1, 4, 6, 8)
 
        'Instance de la feuille de calculs "Feuil1"
        Set FL1 = Worksheets("Feuil1")
    '*******************************************************************************************
 
        'Suppression d'un filtre existant éventuel
        If FL1.FilterMode = True Then FL1.Cells.AutoFilter
 
        'Dernière colonne de la plage de données
        DerCol = Split(FL1.Cells(1, Rows(1).Cells.Count).End(xlToLeft).Address, "$")(1)
 
    'Pose du filtre sur toutes les colonnes de la plage de données
    FL1.Columns("A:" & DerCol).AutoFilter
 
    'Filtrage des n colonnes
    For NoCol = 1 To UBound(Criteres)
        FL1.Cells(Colonnes(NoCol), Colonnes(NoCol)).CurrentRegion.AutoFilter _
                Colonnes(NoCol), Criteres(NoCol)
    Next NoCol
 
    '******************** OPTION : COPIE DE LA PLAGE FILTRÉE SUR FEUIL2 *************************
    Set Plage = FL1.Cells(1, 1).CurrentRegion                                                  '*
    Plage.Copy Worksheets("Feuil2").Cells(1, 1)                                                '*
    '********************************************************************************************
 
End Sub
Pour créer le tableau de critères,
- Avec des données prises dans un userform :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Dim Tablo As Variant
    Tablo = Array(Textbox1, Textbox2, Textbox3, Listbox1, Combobox1)
    For i = 0 To UBound(Tablo)
        MsgBox Tablo(i)
    Next
Avec les données contenues dans des variables :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Dim Tablo As Variant, Nom$, Prenom$, Fonction$, Ref$
    Nom = "Marcel"
    Prenom = "Etienne"
    Fonction = "Chef"
    ref = "24250c"
    Tablo = Array(Nom, Prenom, Fonction, ref)