filtre élaboré vba

Option Compare Text
Sub nettoyage_fichier()

Worksheets("extract").Activate
    Range("A11", "Y5000").Select
        Selection.Delete
                      
          
End Sub

Sub filtre_elab()

Dim tab1() As Variant
' Procedure
'----------
test tab1

' Creation des feuilles
'----------------------
For i = 1 To UBound(tab1, 1)
    If tab1(i, 9) <> "x" Then
        Sheets("template").Copy after:=Sheets(Sheets.Count) 'on copie la feuille template en dernier
        Sheets(Sheets.Count).Name = tab1(i, 8) 'on la renomme avec le nom du département
    End If
Next i
i = Empty

' Remplissage selon condiction (on renvoie toutes les personnes du departement)
'------------------------------------------------------------------------------

For i = 1 To UBound(tab1, 1)
    For k = 1 To UBound(tab1, 2) - 1
        Sheets(tab1(i, 8)).Cells(Sheets(tab1(i, 8)).Cells(65536, k).End(xlUp).Row + 1, k) = tab1(i, k)
    Next k
Next i

End Sub

Sub test(tab1() As Variant)
' Procedure ci-dessous
'---------------------
Dim Fextract As Worksheet
Set Fextract = Worksheets("extract")

tab1 = Fextract.Range(Fextract.Cells(11, 1), Fextract.Cells(Fextract.Cells(65536, 1).End(xlUp).Row, 8))
ReDim Preserve tab1(1 To UBound(tab1, 1), 1 To 9)

For i = 1 To UBound(tab1, 1)
    For j = i + 1 To UBound(tab1, 1)
        If tab1(i, 8) = tab1(j, 8) Then
            tab1(j, 9) = "x"
        End If
    Next j
Next i
i = Empty
j = Empty

End Sub