Découper un fichier Excel en plusieurs nouveaux classeurs
Bonjour,
Je dispose d'un fichier Excel contenant 5444 lignes, et je souhaiterai découper automatiquement ce document en plusieurs fichiers Excel de 100 lignes pour chacun.
En PJ voici le document "source", dont les colonnes de A à I doivent être copiées et insérées des nouveaux fichiers "cible" (également en PJ), et copiés sur la colonne B à J.
L'idéal consisterait également à renommer les nouveaux documents créés en fonction du numéro de la première ligne copiée (exemple: 101), ainsi que le numéro de la dernière ligne copiée (exemple: 200) afin de disposer d'un nom unique (nouveau nom de classeur: "101-200")
Etant donné que je pédale dans la semoule, je sollicite votre aide afin de disposer de pistes de démarrage.
Merci bcp
Cdt
Bonjour,
Tu peux essayer le VBA suivant dans un module situé dans ton ficheir "source",
et ensuite d'exécuter la macro "cutSource".
Attention, les ficheir sont nommés "wkbxxx-yyy" et créés dans le repertoire courant.
De préférence, ils ne doivent pas exister sinon tu devra confirmer l'écrasement.
Option Explicit
Const nbLignes = 100
Function addwkb() As Workbook
Dim NWkb As Workbook
Set NWkb = Workbooks.Add()
Set addwkb = NWkb
End Function
Sub cutSource()
Dim I As Integer
Dim J As Integer
Dim sourceWkb As Workbook
Dim sourceSheet As Worksheet
Dim destWkb As Workbook
Dim destSheet As Worksheet
Dim fileName As String
I = 2 ' on démarre à la 2eme ligne du fichier source
J = 2
Set sourceWkb = ActiveWorkbook
Set sourceSheet = ActiveSheet
fileName = "wkb" & Left("00" & Trim(Str(I)), 3) & "-" & Left("00" & Trim(Str(I + 99)), 3)
Set destWkb = addwkb()
Set destSheet = ActiveSheet
sourceSheet.Activate
Range("A" & Trim(Str(I))).Select
While ActiveCell.Value <> ""
If ((I Mod nbLignes) = 0) Then
destWkb.Close True, fileName
fileName = "wkb" & Left("00" & Trim(Str(I)), 3) & "-" & Left("00" & Trim(Str(I + 99)), 3)
Set destWkb = addwkb()
Set destSheet = ActiveSheet
J = 2
End If
copyCol sourceSheet, destSheet, I, J
I = I + 1
J = J + 1
sourceSheet.Activate
Range("A" & Trim(Str(I))).Select
Wend
destWkb.Close True, fileName
End Sub
Sub copyCol(source As Worksheet, dest As Worksheet, I As Integer, J As Integer)
Dim Ch As String
source.Activate
Range("A" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("B" & Trim(Str(J))).Value = Ch
source.Activate
Range("B" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("C" & Trim(Str(J))).Value = Ch
source.Activate
Range("C" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("D" & Trim(Str(J))).Value = Ch
source.Activate
Range("D" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("E" & Trim(Str(J))).Value = Ch
source.Activate
Range("E" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("F" & Trim(Str(J))).Value = Ch
source.Activate
Range("F" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("G" & Trim(Str(J))).Value = Ch
source.Activate
Range("G" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("H" & Trim(Str(J))).Value = Ch
source.Activate
Range("H" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("I" & Trim(Str(J))).Value = Ch
source.Activate
Range("I" & Trim(Str(I))).Select
Ch = ActiveCell.Value
dest.Activate
Range("J" & Trim(Str(J))).Value = Ch
End Sub
Bonjour,
Tout d'abord merci beaucoup pour votre collaboration.
La macro m'a semblé fonctionner, or je ne retrouve pas les fichiers découpés. COmment faire pour choisir une destination de copie des classeurs? Ou alors où ont ils pu être enregistrés?
J'ai lancé la macro depuis un dossier nommé (test découpe) crée sur mon bureau...
Bonjour,
Normalement ils vont dans le répertoire "courant" de windows.
Si tu veux fixer le répertoire, tu peux modifier les lignes contenant fileName:
fileName = "wkb" & Left("00" & Trim(Str(I)), 3) & "-" & Left("00" & Trim(Str(I + 99)), 3)
à changer en
fileName = "c:\repertoire\wkb" & Left("00" & Trim(Str(I)), 3) & "-" & Left("00" & Trim(Str(I + 99)), 3)
Mais bien sûr, dans ce cas il est figé à "c:\repertoire"
Sinon il faudrait ajouter un peu de code pour indiquer le répertoire où on veut les mettre.
Bonjour
Pour ma formation personnelle et à toute fin utile, j'ai repris le code de Fregoli pour essayer de le simplifier
Premièrement : J'ai copié le fichier Source "eboiteux Source V001.xlsm" et le fichier cible "eboiteux Cible.xlsx" dans un répertoire nommée "eboiteux"
Remarque : Le bouton de recopie doit être en dehors des données sinon il est recopié dans le fichier
A voir
Merci beaucoup,
J'ai quelques petites retouches perso à effectuer sur ce fichier pour qu'il fit avec mes besoins, mais l'idée principale est là.
Merci à vous deux pour votre collaboration