Problème de filtre sur 1 champ unique

Bonjour à tous !

J'ai un problème de filtre avec 3 critères dans une colonne pourtant le code fonctionne bien avec seulement 2 critères lorsque je veux ajouter un autre critère j'obtiens cette erreur

Erreur de compilation

Argument nommé introuvable

J'ai cherché sur le net ou forum et la raison que j'obtiens avec la recherche est une mauvaise orthographe. J'ai vérifié et tout semble "OK" de ce côté...

Si une âme charitable pourrait m'aider...

Merci à l'avance !

Bonjour,

À valider.

Sub Filtre()
    Dim plageFeuil4
    Dim F1 As Worksheet
    Dim F2 As Worksheet
    Set F1 = Worksheets("Data")
    Set F2 = Worksheets("Filtrage")
    Dim dl
    dl = F1.Range("A" & Rows.Count).End(xlUp).Row
    F2.Range("A:W").ClearContents
    Application.ScreenUpdating = False

    With F1
        Range("AH1:AH" & dl).FormulaR1C1 = "=""|""&RC1&""|""&RC2&""|""&RC3&""|""&RC4&""|""&RC5&""|""&RC6&""|""&RC7&""|""&RC8&""|""&RC9&""|""&RC10&""|""&RC11&""|""&RC12&""|""&RC13&""|""&RC14&""|""&RC16&""|""&RC17&""|""&RC18&""|""&RC19&""|""&RC20&""|""&RC21&""|""&RC22&""|"""

        .Range("AH1").AutoFilter
        ' Utilisation d'un tableau pour les critères
        Dim critTable As Variant
        critTable = Array("*|" & .Cells(1, 30).Value & "|*", "*|" & .Cells(1, 31).Value & "|*", "*|" & .Cells(1, 32).Value & "|*")

        ' Application des filtres
        .Range("AH1:AH" & dl).AutoFilter Field:=1, Criteria1:=critTable, Operator:=xlFilterValues

        ' Copie des données filtrées
        If .Range("A1").CurrentRegion.Rows.Count >= 1 Then
            .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A1")
        End If

        ' Définition de la plage
        If .Range("A1").CurrentRegion.Rows.Count >= 1 Then
            Set plageFeuil4 = .Range("A1").CurrentRegion.Offset(1).Resize(.Range("A1").CurrentRegion.Rows.Count)
        End If
    End With

    F1.Range("AH1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Oiseau bleu

Bonjour à tous !

@oiseaubleu, désolé ça ne fonctionne pas...

Bonjour,

Un autre essai.

Sub Filtre()
    Dim plageFeuil4 As Range
    Dim F1 As Worksheet
    Dim F2 As Worksheet
    Dim dl As Long

    ' Utilisation des feuilles déclarées
    Set F1 = Worksheets("Data")
    Set F2 = Worksheets("Filtrage")

    ' Trouver la dernière ligne de la colonne A
    dl = F1.Range("A" & F1.Rows.Count).End(xlUp).Row

    ' Effacer le contenu de la plage de destination
    F2.Range("A:W").ClearContents

    ' Désactiver la mise à jour de l'écran pour améliorer les performances
    Application.ScreenUpdating = False

    ' Appliquer le filtre sur la feuille "Data"
    With F1
        .Range("AH1:AH" & dl).FormulaR1C1 = "=""|""&RC1&""|""&RC2&""|""&RC3&""|""&RC4&""|""&RC5&""|""&RC6&""|""&RC7&""|""&RC8&""|""&RC9&""|""&RC10&""|""&RC11&""|""&RC12&""|""&RC13&""|""&RC14&""|""&RC16&""|""&RC17&""|""&RC18&""|""&RC19&""|""&RC20&""|""&RC21&""|""&RC22&""|"""

        ' Application des filtres sans utiliser Criteria3
        .Range("AH1:AH" & dl).AutoFilter Field:=1, Criteria1:="*|" & .Cells(1, 30).Value & "|*" _
            , Criteria2:="*|" & .Cells(1, 31).Value & "|*", Operator:=xlAnd

        ' Copier les données filtrées vers la feuille de destination
        If .Range("A1").CurrentRegion.Rows.Count >= 1 Then
            .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A1")
        End If

        ' Définir la plage
        If .Range("A1").CurrentRegion.Rows.Count >= 1 Then
            Set plageFeuil4 = .Range("A1").CurrentRegion.Offset(1).Resize(.Range("A1").CurrentRegion.Rows.Count)
        End If
    End With

    ' Désactiver le filtre sur la feuille "Data"
    F1.Range("AH1").AutoFilter

    ' Réactiver la mise à jour de l'écran
    Application.ScreenUpdating = True
End Sub

Oiseau bleu

Re Bonjour !

Non, ça ne fonctionne pas...seulement pour les 2 premiers critères mais pas le 3 ième

bonjour Nordik_Nation,OiseauBleu,

un essai avec

Sub Filtrer2()
     Dim shF

     Set shF = Sheets("filtrage")
     shF.UsedRange.ClearContents

     With Sheets("Data")
          If .AutoFilterMode Then .AutoFilterMode = False
          If .FilterMode Then .ShowAllData
          With .Range("A1").CurrentRegion.Resize(, 23)
               With .Columns(23)
                    .Formula2R1C1 = "=SUM(--(COUNTIF(RC3:RC22,R1C30:R1C32)>0))"
                    .Cells(1) = "comptage"
               End With
               .AutoFilter 23, 3
               .Copy shF.Range("A1")
               .AutoFilter
          End With
     End With

     With shF
          .UsedRange.EntireColumn.AutoFit
          Application.Goto .Range("A1")
     End With
End Sub

Bonsoir à tous !

BsAlv, en modifiant votre formule ça fonctionne

.Formula2R1C1 = "=SUM(--(COUNTIF(RC3:RC22,R1C30:R1C32)>0))"

par celle-ci

.FormulaR1C1 = "=COUNTIF(RC[-20]:RC[-1],R1C30)+COUNTIF(RC[-20]:RC[-1],R1C31)+COUNTIF(RC[-20]:RC[-1],R1C32)"

Je vous remercie !

Remerciement également @oiseaubleu pour les essais

Bonne soirée !

re,

je crains que ma formule était matricielle (donc +CTRL+MAJ+ENTER) et cela ne se voit plus dans excel365.

Re Bonsoir !

Oui, formule matricielle je l'ai même essayé manuellement mais je crois que c'est à cause de ma version Excel que votre formule ne fonctionnait pas même en retirant le 2 de Formula ça ne fonctionnait pas

Je vous remercie encore !

Bonne soirée !

re, j'avais besoin de "formulaarray", mais si c'est un tableau structuré, c'est même plus simple, voir les 2 macros avec leur listobject