Un fichier par ID

Bonjour a tous je suis un peu dans une impasse, j'aimerais créer une macro me permettant de créer un fichier par identifiant.

Mon fichier comporte en colonne A les ID ranger dans l'ordre et j'aimerais créer un fichier pour chaque ID distinct, tout en collant les données des colonnes A:R

Avez vous des tutoriels pour la création de nouveau fichier en vba ? j'ai du mal a trouver ça

Merci d'avance

Bonjour

Cordialement

Bonjour, d'aprés vos explications ce ne sont pas des nouveaux fichier mais plutôt

une copie d'un modèle avec des infos à reporter.

Sans votre fichier exemple "anonyme" avec ce que vous souhaitez réaliser par ID difficile d'expliquer.

Le principe Une Feuille "modèle" qui servira à exécuter une commande vba save copy as ..... Nom de l'id se trouvant dans le fichier actuel.

Oops bonjour Dan .

Voila un exemple j'aimerais pour chaque couleur créer un nouveau fichier excel en copiant les lignes dedans.

Bonjour

C'est un nouveau fichier par couleur ou une nouvelle feuille ?
Si nouveau fichier, on le sauve où et avec quel nom ?

Cordialement

Bonjour,

Sub test()
Dim Dico As Object, Filtre As Worksheet
Set Dico = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Feuil1").Range("A1").CurrentRegion
    For I = 2 To .Rows.Count
        Dico(.Cells(I, "A").Value) = .Cells(I, "A").Value
    Next
End With
Set Filtre = ThisWorkbook.Sheets.Add
For Each K In Dico.Keys
    Filtre.Cells.Clear
    Filtre.Range("A1") = "id"
    Filtre.Range("A2") = K
    With Workbooks.Add
        With .Sheets.Add
            FiltreActif ThisWorkbook.Sheets("Feuil1").Range("A1").CurrentRegion, Filtre.Range("A1").CurrentRegion, .Range("A1"), True
            .Name = K
        End With
        Application.DisplayAlerts = False
        .SaveAs K & Format(Date, "-yyyy-mm-dd")
        Application.DisplayAlerts = True
        .Close
    End With

Next
Set Dico = Nothing
Application.DisplayAlerts = False
Filtre.Delete
Application.DisplayAlerts = True
Set Filtre = Nothing
End Sub

Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function