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