A partir d'un fichier global crée un fichier par fournisseur

Bonjour à tous,

Je suis apprenti et débutant dans les macro. Mon tuteur me demande de créer une macro qui permet à partir d'un fichier global réunissant plusieurs fournisseurs de créer un fichier pour chaque fournisseur.

Donc si j'ai 10 fournisseurs dans le fichier global suite à ma macro j'aurais 10 autres fichiers.

Pouvez vous svp m'aider ce serais sympa car j'ai beau chercher je n'arrive pas à débloquer.

Ci joint le fichier avec des données différentes.

Merci d'avance pour votre

alex

Bonsoir,

Une piste, à mettre dans un module standard et exécuter (appuis successifs sur F8 si tu veux exécuter le code en pas à pas) :

Sub PlusieursFournisseurs()

    Dim Classeur As Workbook
    Dim PlageSource As Range
    Dim PlageCopie As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Derlgn As Long

    With Worksheets("Feuil1")

        'sur la colonne "Y" à partir de Y2
        Set PlageSource = .Range(.Cells(2, 25), .Cells(.Rows.Count, 25).End(xlUp))

        'utilisé pour savoir si le classeur est déjà créé
        Set Dico = CreateObject("Scripting.Dictionary")

        'parcour la plage
        For Each Cel In PlageSource

            'copie la ligne en cours de la colonne A à AA
            Set PlageCopie = Range(Cel.Offset(, -24), Cel.Offset(, 2))

            'si pas encore dans le dico
            If Dico.exists(Cel.Value) = False Then

                Dico.Add Cel.Value, Cel.Value

                'crée le classeur
                Set Classeur = Workbooks.Add

                'y copie la ligne d'entêtes
                .Range("A1:AA1").Copy Classeur.Worksheets("Feuil1").Range("A1")

                'puis la plage en cours
                PlageCopie.Copy Classeur.Worksheets("Feuil1").Range("A2")

                'enregistre le classeur dans le même dossier avec le nom du fournisseur
                Classeur.SaveAs Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) & Cel.Value & ".xls"

            Else

                'si déjà créé, le réouvre
                Set Classeur = Workbooks.Open(Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) & Cel.Value & ".xls")

                'cherche la première ligne vide
                With Classeur.Worksheets("Feuil1")

                    Derlgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A

                End With

                'puis colle les valeurs
                PlageCopie.Copy Classeur.Worksheets("Feuil1").Range("A" & Derlgn)

                'enregistre
                Classeur.Save

            End If

            'ferme le classeur
            Classeur.Close

        Next Cel

    End With

End Sub

Hervé.

Merci énormément Hervé c'est parfaitement ce que je cherchais. Merci d'y avoir consacré du temps.

Cordialement

Alex

Bonjour,

Et a l'inverse l'on pourrait rassembler plusieurs fichiers les uns a la suite des autres ?

Merci d'avance

Marion