XL 2019 Filtre Avancé avec un tableau comme cristaire vba

iliess

XLDnaute Occasionnel
Bonjour
est ce que je peux utiliser un tableau Arr comme la plage d'un filtre avancé et le tableau Grr comme plage de critère.
voici le code suivant

VB:
Sub test()
Dim ShBa As Worksheet, ShGr As Worksheet
Dim LignA As Long
Dim Arr
Set ShBa = ThisWorkbook.Worksheets("BaseD")
Set ShGr = ThisWorkbook.Worksheets("Resultat")
LignA = ShBa.Cells(ShBa.Rows.Count, 1).End(xlUp).Row
lignb = ShGr.Cells(ShGr.Rows.Count, 1).End(xlUp).Row
Arr = ShBa.Range("A2:I" & LignA)
n = 2
'================================================================
For i = LBound(Arr, 1) To UBound(Arr, 1)
    If Arr(i, 9) <> "Non" Then
            ShBa.Range("M" & n) = ("'" & Arr(i, 4))
            ShBa.Range("N" & n) = "*445"
            n = n + 1
    End If
Next i
'================================================================
ShBa.Range("A1:I" & LignA).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("M1").CurrentRegion, CopyToRange:=Sheets("Resultat").Range("A1"), Unique:=False
End Sub
le tableau Arr = Range("A1").CurrentRegion
le tableau Grr = Range("M1").CurrentRegion

est ce que je peux remplir le tableau Grr on utilisent cette boucle

Code:
For i = LBound(Arr, 1) To UBound(Arr, 1)

    If Arr(i, 9) <> "Non" Then

            Grr(i,1) = ("'" & Arr(i, 4))

            Grr(i,2) = "*445"

            n = n + 1

    End If

Next i
Arr.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Grr, CopyToRange:=Sheets("Resultat").Range("A1"), Unique:=False
 

Pièces jointes

  • teste.xlsm
    22.8 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
294 412
Messages
1 938 344
Membres
188 786
dernier inscrit
hamza ait bouchaib