Dispatcher donnée d'un tableau sur plusieurs feuilles par code

Bonjour à tous,

dans mon fichier j'ai au début Feuil 1 ou j'ai un tableau exporté d'un logiciel de comptabilité.

ce que je cherche: un code à lier au bouton ventilation que j'ai das la colonne Y (Feuil1) qui permet de ventiler le même tableau mais par code que j'ai dans la colonne B.

j'ai fait un exemple manuellement:

pour le code B2: le code copie l'entête du tableau CAD la première ligne ensuite le ligne du code B2 qui se trouve sur une seule ligne sans oublier nommer la feuille avec le code

pour le code B3: le code copie l'entête du tableau CAD la première ligne ensuite les lignes 3, 4, 5, 6, 7, 8 parce que dans la colonne B ont le même code sans oublier nommer la feuille avec le code

le code doit faire pareil pour tout le tableau

merci d'avance pour votre assistance

Amicalement

Michel

Bonjour et bienvenue sur le forum

Un essai à tester. Te convient-il ?

Bye !

Bonsoir à tous,

Avec le filtre automatique :

Option Explicit
Sub test()
Dim a, e, dico As Object, wsName As String
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Feuil1")
        With .Range("a1").CurrentRegion
            a = .Columns(2).Offset(1).Resize(.Rows.Count - 1).Value
            For Each e In a
                If Not dico.exists(e) Then
                    dico(e) = Empty
                    wsName = e
                    If Not Evaluate("isref('" & wsName & "'!a1)") Then
                        Sheets.Add(after:=Sheets(Sheets.Count)).Name = wsName
                    End If
                    Sheets(wsName).Cells.Delete
                    .AutoFilter 2, e
                    .SpecialCells(xlCellTypeVisible).Copy Sheets(wsName).Cells(1)
                    .AutoFilter
                End If
            Next
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir gmb, klin89, le forum

je vous remercie pour la promptitude de votre réponse.

après un test sur le fichier je confirme que c'est bien ce que je voulais comme résultat, reste juste deux petites rectifications à rajouter si possible.

1- je veux que les feuilles créées soient classées par ordre croissant, c'est a dire par feuille qui a comme nom le code le plus petit jusqu'à celle qui comme nom la la valeur la plus élevée.

2- les tableaux des feuilles créées doivent être cadrés par bordure de type xlContinuous, et au milieu du tableau bordures de type xlDot, et la première ligne des tableaux soit coloré en vert.

merci encore une autre fois pour votre assistance

Amicalement

re michel-nac

Comme ceci :

Option Explicit
Sub test()
Dim a, i As Long, AL As Object, wsName As String
    Application.ScreenUpdating = False
    Set AL = CreateObject("System.Collections.ArrayList")
    With Sheets("Feuil1")
        With .Range("a1").CurrentRegion
            a = .Columns(2).Offset(1).Resize(.Rows.Count - 1).Value
            For i = 1 To UBound(a, 1)
                If Not AL.Contains(a(i, 1)) Then AL.Add a(i, 1)
            Next
            AL.Sort
            For i = 0 To AL.Count - 1
                wsName = AL(i)
                If Not Evaluate("isref('" & wsName & "'!a1)") Then
                    Sheets.Add(after:=Sheets(Sheets.Count)).Name = wsName
                End If
                Sheets(wsName).Cells.Clear
                .AutoFilter 2, AL(i)
                .SpecialCells(xlCellTypeVisible).Copy Sheets(wsName).Cells(1)
                'Mise en forme
                With Sheets(wsName).Cells(1).CurrentRegion
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlThin
                    With .Rows(1)
                        .BorderAround Weight:=xlThin
                        .HorizontalAlignment = xlCenter
                        .Interior.ColorIndex = 43
                    End With
                    .Columns.AutoFit
                End With
                .AutoFilter
            Next
        End With
    End With
    Set AL = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Re-Bonsoir klin89,

je vous remercie beaucoup pour la rapidité et l’efficacité de vos réponses.

c'est exactement ce que je souhaitais avoir comme résultat.

j'ai une dernière demande si vous le permettez :

est ce que ce serait possible d'avoir un autre code qui sera lié à un autre bouton qui me permettra de supprimer toutes les feuilles créées sauf la première ?

je vous remercie encore une autre fois pour votre assistance

Cordialement

Michel