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 SubLe problème est résolu mais je ne trouve pas le moyen de le mettre en résolu
