Split d'une worksheet en plusieurs classeurs

**Aiyolia** · 19/06/2017, 15h01

Bonjour,

j'ai un fichier de plusieurs milliers de lignes, je souhaiterais spliter ce fichier qui est sur une seule sheet en X classeurs distincts de X lignes avec la première ligne qui reste toujours étant l'intitulé des colonnes.

J'ai quelques bases en macro et VBA et j'ai pas mal chercher sur le forum mais je n'ai pas trouvé de discussion qui se rapproche de ça et je ne sais par ou commencer ma macro pour atteindre le résultat.

Si qq'un est susceptible de m'aider ou de me fournir des pistes, je suis preneur.

Si besoin de précision n'hésitez pas.

En vous remerciant par avance.

**joe.levrai** · 19/06/2017, 15h16

Bonjour,

sur quel critère tu te bases pour identifier les lots de lignes à grouper ? Une quantité de X lignes ou des critères de valeurs dans certaines de tes colonnes ?

**halaster08** · 19/06/2017, 15h16

edit: mal compris la demande
edit2:@Oudouner non mon code n'est pas bon dans ce cas il sépare suivant les valeurs et non suivant un certain nombres de lignes

edit3: code fonctionel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub aa()
nbl = 3 'nombre de ligne par classeur
nbc = 4 'nombre de classeur
For i = 0 To nbc - 1
    Workbooks.Add 'crée un classeur
    ThisWorkbook.Sheets(1).Rows(1).Copy ActiveWorkbook.Sheets(1).Rows(1) 'copie l'entete
    ThisWorkbook.Sheets(1).Rows(i * nbl + 2 & ":" & (i + 1) * nbl + 1).Copy ActiveWorkbook.Sheets(1).Rows(2) 'copie les les lignes
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & "_" & i & ".xlsx" 'sauve le classeur
Next i
End Sub

Invité · 19/06/2017, 15h17

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Dim i As Integer
Dim ligneDepart As Integer
Dim NewBook As Workbook
 
ligneDepart = 2 
 
For i = 1 to  'nombre de classeur à créer
 
Set NewBook = Workbooks.Add 'création du classeur
NewBook.SaveAs "C:\Chemin\NomDuClasseur"
 
'copie des entêtes sur la première ligne de ton classeur
'copie les lignes à partir de ligneDepart jusqu'à ton nombre de ligne par classeur
ligneDepart = ligneDepart + X 'incrémente la ligne de départ pour le prochain classeur
 
Next i

Voilà un début qui pourrait t'aider. Je ne sais pas si tu souhaites écrire le nombre de classeur et de lignes en dur ou les demander à l'utilisateur.

**Aiyolia** · 19/06/2017, 15h58

Bonjour,

je vais me pencher sur le début de solution que me propose Oudouner.

Pour affiner ma demande, je n'ai pas de critères particuliers de tri sur les lignes.

Dans les faits j'ai un fichier de 10,000 lignes que je dois implanter dans un système propre à mon entreprise mais qui ne supporte pas une telle charge, avec une capacité max de 800 lignes par fichier.

Je voudrais donc que la macro prenne les lignes par paquet de 800 et les nomme à la suite, du genre Doc1, Doc2, Doc3, Doc1, etc ... En gardant juste la première ligne qui est l'en tête des colonnes.

En fait les 799 lignes copiées peuvent être supprimées du fichier principal, puisqu'elles seront copiées dans un nouveau classeur. Et que cette macro soit répétée X fois jusqu'à ce que le fichier soit vide.

J'espère avoir été plus clair, si besoin d'autres précisions, je reste à votre disposition et merci pour votre aide.

Regards

**patricktoulon** · 19/06/2017, 16h31

les fichiers de destination ont il un extension xl ou peuvent ils êtres des csv

**Aiyolia** · 19/06/2017, 16h41

Les classeurs finaux doivent être sous format .xls pour pouvoir fonctionner.

Si cela aide par contre, je peux retransformer mon fichier initial en .csv, même si je ne vois pas la finalité.

**patricktoulon** · 19/06/2017, 16h46

en csv le travail ne durerait pas plus de 3 ou 4 secondes

**Aiyolia** · 19/06/2017, 17h15

Effectivement, en CSV, le résultat serait plus rapide, mais la contrainte système fait que je dois passer par du xlsx en finalité.

La réponse de Halaster08 est parfaite et répond parfaitement à l'ensemble de mes besoins, merci beaucoup

.

Par contre, soit c'est moi soit c'est la fatigue mais j'ai essayé de modifier le path pour sauver les fichiers générés dans un folder précis et sous un autre nom mais ça ne marche pas, peux tu me dire ou est mon erreur ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.SaveAs ThisWorkbook.Path & "F:\TEST\" & Split(ThisWorkbook.Name, "STAR")(0) & "_" & i & ".xlsx" 'sauve le classeur

**patricktoulon** · 19/06/2017, 17h51

sinon
voila un exemple avec un fichier de départ avec 40000 lignes sur 7 colonnes
qui te sauve donc 51 fichiers csv de 800 lignes dont la première et toujours la même (ligne 1 originale)

le tout roulement de tambours ......
moins de 2 seconde chez moi
de plus il y a création de dossier pour la destination si il existe pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub testaaaaaa()
    Dim chemin As String, memo As Object, plage As Range, ligne As String, derlig As Long, dercol As Long, T As String, X, fichier As String
    chemin = ThisWorkbook.Path & "\fichiersdecoupés"
    If Dir(chemin, vbDirectory) = "" Then MkDir (chemin)
    Set memo = CreateObject("htmlfile")
    With ActiveSheet
        Set plage = ActiveSheet.UsedRange
        ligne = Join(WorksheetFunction.Index(plage.Value, 1, 0), ";")
        derlig = ActiveSheet.Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Row
        dercol = plage.Column + plage.Columns.Count - 1
        For i = 2 To derlig Step 798
            a = a + 1
            clearall = memo.parentwindow.clipboardData.setData("Text", "")    'on vide le clipboard au cas ou il y aurait quelque chose
            ind2 = IIf(i + 798 < derlig, i + 798, derlig)
            .Range("A" & i, .Cells(ind2, dercol)).Copy
            T = Replace(Replace(memo.parentwindow.clipboardData.GetData("TEXT"), vbTab, ";"), vbCrLf, ";" & vbCrLf)
            fichier = chemin & "\fichier " & a & ".csv"
            X = FreeFile
            Open fichier For Output As #X
            Print #X, ligne & vbCrLf & T
            Close #X
        Next
    End With
Application.CutCopyMode = False
End Sub

ca donne a réfléchir a la conception de ton organisation n'est ce pas ???
encore une qui devrait plaire a Robert

edit:

j'ajouterais que sur cet base dans la boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Range("A" & i, .Cells(ind2, dercol)).Copy

il te serait possible de le faire en xlsx

**halaster08** · 20/06/2017, 08h37

Envoyé par Aiyolia

Par contre, soit c'est moi soit c'est la fatigue mais j'ai essayé de modifier le path pour sauver les fichiers générés dans un folder précis et sous un autre nom mais ça ne marche pas, peux tu me dire ou est mon erreur ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.SaveAs "F:\TEST\" & Split(ThisWorkbook.Name, "STAR")(0) & "_" & i & ".xlsx" 'sauve le classeur

Si tu fixe un chemin plus besoin de thisworkbook.path qui était la pour envoyer le résultat dans le même répertoire que le xlsm qui les construit.

**Aiyolia** · 20/06/2017, 09h53

Effectivement Patrick, ta solution marche tout aussi bien

et je vais pouvoir l'utiliser pour une autre application, merci beaucoup.

Et oui merci Halaster, effectivement ta remarque est évidente :/.

Merci beaucoup à vous pour votre aide, je passe le sujet en résolu.

Split d'une worksheet en plusieurs classeurs [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager