Splitter un fichier global en plusieurs sous fichiers

Bonjour !

Tout d'abord merci pour votre patience et présence. Je vais expliquer mon petit soucis.

L'idée est simple je veux faire une macro qui à partir d'un fichier global, extrait toutes les données du client A et créer un fichier à son nom.. puis le client B .. C .. D etc ! Le but est donc de créer des sous fichiers du fichier global. Je me heurte à un soucis.

Lorsque je parcours mon tableau. Cela se déroule correctement jusqu'à un certain moment ou le split par client ne se fait plus et je me retrouve avec un dernier fichier ou des infos s'y retrouvent sans split les prochains clients.

Je pense que le soucis viens du fait que je supprime les lignes de la plage au fur et a mesure, ce qui causerai un décalage ?

Je me suis dis que je devais remonter le tableau depuis la dernière ligne et la .. je sèche ! Merci de votre aide. J'espère être le plus clair possible.

J'ai quelques notions de VBA mais cela se "limite" a ce que vous allez voir dans ce bout de code justement.

Petite infos j'ai rajouté le numéro de la ligne dans le nom du fichier pour permettre d'identifier la ou le soucis se pose. J'ai remarqué qu'en mettant la partie suppression de ligne en commentaires. Les sous fichiers se font correctement mais avec toutes les données du client précédent .. exemple fichier A = client A mais fichier B = client A et B et ainsi de suite

Sub Cut()
    Dim ws As Worksheet
    Dim rng As Range
    Dim entete As Range
    Dim plage As Range
    Dim nomfeuille As String
    Dim lastrow As Long
    Dim cellule As Range

    nomfeuille = ActiveSheet.Name
    Set ws = ActiveSheet
    'Set plage = ws.Range("C2:C10000").Cells
    Set plage = ws.Range("B2", Range("B2").End(xlDown)).Cells

    For Each cellule In plage
        If ws.Cells(cellule.row, 2).Value <> ws.Cells((cellule.row) + 1, 2).Value Then

            Set entete = Range("A1:Z1")
            Set rng = Range("A2:Z" & cellule.row)

            'creation du workbook et copy des datas
            Application.Workbooks.Add
            Set ws = Application.ActiveSheet
            entete.Copy Destination:=ws.Range("A1")
            rng.Copy Destination:=ws.Range("A2")
            'save du new workbook
            ActiveWorkbook.SaveCopyAs "C:\Users\XXXXXXXXXXXXXXXXXXX" & Range("C2").Value & " - " & nomfeuille & cellule.row & ".xlsx"
            ActiveWorkbook.Close SaveChanges:=False

            'ici je supprime la plage copié
            rng.EntireRow.Delete
            Set ws = ActiveSheet
            Set plage = ws.Range("B2", Range("B2").End(xlDown)).Cells

        End If

    Next cellule

End Sub

Bonjour,

Est ce que les segments pourrait faire l'affaire ?

Cordialement.

Bonjour,

je connais les segments mais j'ai du mal à voir leur utilité dans mon cas. Je loupe peut être quelque chose. Tu sais m'en dire plus ?

merci

Cordialement,

Bonsoir,

Ils te permettent d'afficher le client que tu veux. Après tout dépend de l'usage que tu veux en faire.

Cordialement.

Hello,

oui je connais cependant moi le but est bien d'avoir un fichier par client et ainsi éviter des copier collé pour faire d'autre fichier

J'ai cependant résolu mon problème avec une petite parade dans mon code.

En effaçant les données dans le tableau d'origine. Il suffit ensuite de supprimer lors de la copie du client suivants toutes les lignes vides.

PS : oui je copie en A3 pour toujours avoir une ligne vide.. ce n'est pas très propre mais me permet de gérer l'erreur en cas de non présence de ligne vide (arrive uniquement au premier client).

Sub Split()
    'declaration variable
    Dim ws As Worksheet
    Dim nomfeuille As String

    Dim tableau As Range
    Dim plage As Range
    Dim entete As Range

    Dim cellule As Range
    Dim lastrow As Long

    'setup variable

    nomfeuille = ActiveSheet.Name
    Set ws = ActiveSheet
    Set tableau = ws.Range("C2", Range("C2").End(xlDown)).Cells

    Application.ScreenUpdating = False

    'boucle
    timerAvant = Timer
    For Each cellule In tableau
        If ws.Cells(cellule.row, 3).Value <> ws.Cells((cellule.row) + 1, 3).Value Then

            Set entete = Range("A1:AB1")
            Set plage = Range("A2:AB" & cellule.row)

            'creation du workbook et copy des datas
            Application.Workbooks.Add
            Set ws = Application.ActiveSheet
            entete.Copy Destination:=ws.Range("A1")
            plage.Copy Destination:=ws.Range("A3") 'A3 car permet de gérer l'erreur en cas de non ligne vide.

            'delete les lignes vides dans le nouveau workbook
            ws.Range("A1", Range("A1").End(xlDown)).Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

            'save du new workbook
            ActiveWorkbook.SaveCopyAs "C:\Users\XXXXXXXX\" & Range("C2").Value & " - " & nomfeuille & ".xlsx"
            ActiveWorkbook.Close SaveChanges:=False

            'ici je clear la plage copié dans le workbook d'origine
            plage.EntireRow.ClearContents
            Set ws = ActiveSheet

        End If

    Next cellule

    Application.ScreenUpdating = True
    MsgBox "Split terminer en : " & Timer - timerAvant & " secondes."

End Sub

Le problème est résolu mais je ne trouve pas le moyen de le mettre en résolu

image
Rechercher des sujets similaires à "splitter fichier global fichiers"