Boucler sur tous les criteres d'un filtre

[Nougat7]

Bonjour le forum,

voila j'ai un petit soucis que je sais resoudre de maniere barbare mais j'essaye de me perfectionner et j'aimerai donc utiliser une autre methode plus propre.

Ce que je fait actuellement c'est de faire un filtre élaboré sans doublon sur la colonne que je dois filtrer que je copie dans la premiere colonne non utilisé, là je boucle sur tous les criteres de filtrage que je rentre dans le filtre automatique:

Sub boucle_filtre()

    Dim champs_recherché As String
    Dim colonne_dispo As Byte
    Dim criteres As Variant
    Dim x As Long
    
    champs_recherché = ThisWorkbook.Sheets(2).Range("A1").Value
    If champs_recherché = "" Then
        MsgBox "Mettez le nom d'un champs de la feuille 1 dans la cellule 'A1' de la feuille 2!", vbCritical, "Erreur"
        Exit Sub
    End If
    With ThisWorkbook.Sheets(1)
        'ecrire en cellule A1 de la feuille 2 un champs a rechercher n'importe ou dans la feuille 1, champs contenant en dessous plusieurs données
        Set champs_trouvé = .Cells.Find(What:=champs_recherché, lookat:=xlWhole)
        If champs_trouvé Is Nothing Then
            MsgBox "Le champs '" & champs_recherché & "' n'a pas été trouvé dans la feuille 1!", vbCritical, "Erreur"
            Exit Sub
        End If
        colonne_dispo = .Range("IV1").End(xlToLeft).Offset(0, 1).Column

        [COLOR="Red"].Columns(champs_trouvé.Column).AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=.Columns(colonne_dispo)[/COLOR]

        .Cells(1, colonne_dispo) = "Sans doublons"
        .Cells(1, colonne_dispo + 1) = "Reccurence"

        [COLOR="red"]criteres = .Range(.Cells(2, colonne_dispo), .Cells(65536, colonne_dispo).End(xlUp))[/COLOR]

        .Activate
        If .AutoFilterMode = False Then .Rows("1:1").AutoFilter

        [COLOR="Red"]For Each critere In criteres[/COLOR]
            If critere <> "" Then
                Selection.AutoFilter Field:=champs_trouvé.Column, Criteria1:=[COLOR="red"]critere[/COLOR]
                
                'code d'une quelconque procedure...
                .Cells(2 + x, colonne_dispo + 1) = Application.Subtotal(3, .Range(champs_trouvé.Offset(1, 0), .Cells(65536, champs_trouvé.Column))) & " fois!"
                x = x + 1
                
                
                .ShowAllData
            End If
        Next critere
    End With
End Sub

J'ai un peu developpé le code mais la seule chose que je cherche à faire, ce serai si possible de recupérer les criteres de filtrage d'un filtre automatique directement en memoire (array...) et si possible sans passer par un filtre élaboré qui copie sur une autre colonne, à la rigueur un filtre élaboré sur place mais cela complique la chose...

voila voila si vous avez des idées n'hesitez pas!!