Microsoft 365 ventiler un fichier excel dans de nouveaux classeurs excel

[SOSOCONNAITPASLEVBA]

Bonjour,

Je suis censée réaliser une tâche grâce à une macro, mais n'ayant eu aucune formation sur le sujet j'en suis bien incapable.
J'ai des données dans une feuille excel avec 12 colonnes. et une ligne d'entête. Je dois créer autant de classeur excel que de code existant dans la colonne A avec l'entête Code 3D. Chaque classeur devra regrouper toutes les lignes du même code 3D existantes de mon classeur d'origine. Avec à chaque fois la ligne d'entête. Le nom de chaque nouveau classeur sera celui du code 3D qu'il regroupe.

J'ai trouvé quelques macro en VBA mais aucune ne correspond exactement à ce que je veux faire.
Quelqu'un peut-il m'aider ?

Bonne soirée
SO

 

[SOSOCONNAITPASLEVBA]

voici un exemple de mon classeur de départ. Les données sont bien entendu fictives.

 

[Jacky67]

voici un exemple de mon classeur de départ. Les données sont bien entendu fictives.

Bonjour,
Une proposition en PJ avec ce code

Sub extraction()
    Dim C As Range, Plage
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .UsedRange
        If .FilterMode Then .ShowAllData
    End With
    Sheets.Add After:=Sheets(Sheets.Count)
    Feuil1.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
    Rows(1).Delete
    For Each C In ActiveSheet.UsedRange
        Plage.AutoFilter Field:=1, Criteria1:=C
        Workbooks.Add
        Plage.SpecialCells(xlCellTypeVisible).Copy ActiveWorkbook.Sheets(1).[a1]
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & C, FileFormat:=51
        ActiveWorkbook.Close False
    Next
    ActiveSheet.Delete
    Plage.AutoFilter
    Application.DisplayAlerts = True
    MsgBox "Création terminée." & vbLf & "Les fichiers se trouvent dans le même répertoire que ce classeur.", , "Information"    ' facultatif
End Sub

 

[SOSOCONNAITPASLEVBA]

Super Jacky67 c'est parfait. j'ai juste ajouté un Columns.Autofit car ça je sais faire.
Merci encore pour ton aide !