XL 2010 VENTILER DES DONNÉES SUR PLUSIEURS FEUILLE

Sub Macro1()
Dim TabIni()  As Variant '==> on déclare un tableau
Set ListeComptes = CreateObject("Scripting.dictionary") 'on déclare un dictionaire


Application.ScreenUpdating = False 'on empeche le rafraichissemnt des feuilles


Set ActShe = ActiveSheet 'on enregistre la feuille active
With ActShe 'avec la feuille active
    Fin = .Range("A" & .Rows.Count).End(xlUp).Row 'on récupère la dernière ligne NON vide de la colonne A
    Set ZoneAFiltrer = .Range("A8:D" & Fin) 'on enregistre la zone à filtrer
    TabIni = .Range("A9:D" & Fin).Value 'on enregistre toutes les données dans le tableau vba
    For i = LBound(TabIni, 1) To UBound(TabIni, 1) 'pour chaque élémenent de la colonne A du tableau
        If Not ListeComptes.exists(TabIni(i, 1)) Then 'si le compte n'existe pas dans le dictionaire, on le crée
            ListeComptes.Add TabIni(i, 1), i
        End If
    Next i
    'ici, on a un dictionaire qui contien tous les numéros de comptes SANS doublon
End With
   
    For Each compte In ListeComptes.keys 'pour chaque compte
        Sheets.Add.Name = compte 'on crée une feuille du nom du compte
        ActShe.Activate 'on repasse sur la feuille Init
        Range("A1:D7").Copy Destination:=Sheets("" & compte & "").Range("A1") 'on copie l'entete

        ZoneAFiltrer.AutoFilter field:=1, Criteria1:=compte 'on filtre les données sur le numéro de compte
        ZoneAFiltrer.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("" & compte & "").Range("A8") 'on copie toutes les lignes filtrées
    Next compte
Application.ScreenUpdating = True 'on réactive le rafraichissement

End Sub

Private Sub ComboBox1_Change()
Dim P As Range, x$, tablo, d As Object, i&, a, b()
Set P = Intersect(Range("A9:A" & Rows.Count), UsedRange)
If P Is Nothing Then ComboBox1.Clear: ComboBox1 = "": Exit Sub
If ComboBox1.ListIndex > -1 Then Union(P(0), P).AutoFilter 1, ComboBox1: Exit Sub 'filtre automatique
'---recherche intuitive---
x = ComboBox1 & "*"
tablo = P.Resize(P.Count + 1) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" And tablo(i, 1) Like x Then d(tablo(i, 1)) = ""
Next
If d.Count = 0 Then ComboBox1.Clear: ComboBox1 = "": Exit Sub
ComboBox1.List = d.keys
If FilterMode Then ShowAllData 'si la feuille est filtrée
ComboBox1.DropDown 'déroule la liste
End Sub