Découper un fichier xls en plusieurs fichiers avec Feuilles
Bonjour,
Je souhaite découper un fichier excel en plusieurs en filtrant sur une colonne A et contenant des feuilles. Par exemple, dans le fichier joint "FichierDepart.xlsx" je voudrais obtenir des fichiers par valeurs qui se trouve dans la colonne A et de reproduire la même traitement pour chaque feuilles, avec comme nom de fichier la valeur de la cellule contenant bien sur toutes les colonnes du fichier de départ.
Exemple:
FichierDepart.xlsx:
Feuil1
Colonne A | Colonne B| Colonne C....
toto 23 France
toto 56 Italie
titi 45 Espagne
Feuil2
Colonne A | Colonne B| Colonne C....
toto 74 Congo
titi 28 Canada
Résultat après traitement:
Fichier nom = Toto.xlsx
Feuil1
Colonne A | Colonne B| Colonne C....
toto 23 France
toto 56 Italie
Feuil2
Colonne A | Colonne B| Colonne C....
toto 74 Congo
////////////////////////////////////////////////////////////////////////////////
Fichier nom = Titi.xlsx
Feuil1
Colonne A | Colonne B| Colonne C....
titi 45 Espagne
Feuil2
Colonne A | Colonne B| Colonne C....
titi 28 Canada
En vous remerciant par avance pour votre aide.
Bonjour,
Voilà quelque chose à tester :
Sub GénérerClasseurs()
Dim d As Object, wbk As Workbook, k, itm, kitm, kk, et, f%, n%, i%, ch$, rw$
Set d = CreateObject("Scripting.Dictionary")
With ThisWorkbook
For f = 1 To .Worksheets.Count
With .Worksheets(f)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
kitm = .Cells(i, 1)
k = "wb_" & kitm: itm = "ws" & f
If d.exists(k) Then
If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
Else
d(k) = ";" & itm
End If
k = itm & "_" & kitm: kitm = kitm & "_" & itm: itm = "rw" & i
If d.exists(k) Then
If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
Else
d(k) = ";" & itm
End If
kitm = kitm & itm: itm = .Cells(i, 1).Resize(, 3).Value
d(kitm) = itm
Next i
End With
Next f
et = .Worksheets(1).Range("A1:C1").Value
ch = .Path & "\"
End With
Application.ScreenUpdating = False
For Each k In d.keys
If k Like "wb_*" Then
kitm = Split(k, "_")(1)
Set wbk = Workbooks.Add(xlWBATWorksheet)
wbk.SaveAs ch & kitm & ".xlsx"
itm = Split(d(k), ";")
With wbk
If UBound(itm) > 1 Then
For f = 2 To UBound(itm)
.Worksheets.Add after:=.Worksheets(f - 1)
Next f
End If
For f = 1 To UBound(itm)
kk = Split(d(itm(f) & "_" & kitm), ";"): n = 1
With .Worksheets(f)
.Cells(n, 1).Resize(, 3).Value = et
For i = 1 To UBound(kk)
n = n + 1
rw = kitm & "_" & itm(f) & kk(i)
.Cells(n, 1).Resize(, 3).Value = d(rw)
Next i
End With
Next f
.Close True
End With
End If
Set wbk = Nothing
Next k
End Sub
Je n'ai pas mis de bouton, à toi de t'organiser selon tes préférences... Pour tester, tu peux simplement lancer la macro à partir de la boîte de dialogue macro.
Préalablement, il convient d'enregistrer le classeur départ dans un dossier. Les classeurs créés seront enregistrés dans le même dossier et tu les y retrouveras après exécution de la macro.
Cordialement.
Bonsoir MFerand et merci de prendre du temps pour mon problème.
tu as répondu exactement à ma demande.
merci encore pour ton aide
Bonjour à tous !
Je relance ce "vieux" sujet, mais j'ai besoin d'un complément d'information !
Alors voilà, j'ai utilisé le code indiqué ci-dessus pour mon propre fichier, et c'est parfait, ça fonctionne à merveille !
Je m'interroge juste sur le nom que porte les fichiers lors de leur création après l'enregistrement automatique.
Actuellement, ils portent le nom de la colonne A (3 cellules différentes en colonne A = 3 fichiers disctincs)
J'aimerais donc pouvoir modifier ça, et soit faire en sorte d'utiliser cette formule pour d'autre colonne, et aussi pouvoir combiner les noms des fichiers par les cellules des colonnes A & B....
Merci de votre aide!
Cdlt,
Bonjour,
Ce code est adapté si tu as exactement la même configuration de départ et si tu veux faire la même chose.
La situation étant très personnalisée, le code l'est donc également !
On part d'un classeur comportant des mentions sur 3 colonnes (le nb de colonnes importe peu, ça s'adapte aisément...
Si tu opères dans une structure exactement similaire, cette procédure peut en effet être adaptable...
Comme tu peux le voir, elle procède en deux temps : recueil de toutes les données, puis constitution des nouveaux classeurs à partir des données recueillies.
La partie délicate réside dans le recueil des données, pour lequel on utilise l'outil Dictionary.
On n'utilise formellement qu'un seul dictionnaire, mais on en constitue 3 distincts qui pourront cohabiter dans le même ensemble :
- un dico nom d'abord : un élément de dictionnaire dont la clé est le nom par futur classeur à constituer, le contenu de chaque élément dico est une chaîne listant les feuilles du futur classeur ;
- un dico nom-feuille ensuite : soit un élément dico dont la clé est formée par concaténation du nom avec une indication de feuille, il y aura autant d'éléments de l'espèce que le nombre total de feuilles dans l'ensemble des classeurs à constituer, le contenu de chaque élément est une chaîne listant les lignes qui devront être insérées dans la feuille identifiée ;
- un dico nom-feuille-ligne enfin : soit élément dico dont la clé concatène le nom avec une indication de feuille et une indication de ligne, il y aura autant d'éléments de ce type que de lignes de données à reporter dans l'ensemble des classeurs, le contenu de chaque élément est constitué par les données, recueillies sous forme de tableaux.
Si tu peux te situer dans un tel processus, des variations de détails peuvent sans doute être introduites à des fins d'adaptations, tant qu'on suit la même trajectoire, organisation similaire des données de départ et objectif identique de réalisation.
Si cela correspond, on peut adapter sans difficulté majeure. Sinon, la procédure n'est pas adaptée, on l'abandonne sans regret et on repart à zéro sur l'analyse du problème pour concevoir une procédure qui soit adaptée !
A toi de répondre à cette question !
Bonjour à tous,
Je suis moi aussi à la recherche d'aide pour mettre en place une macro qui découpe un fichier XLS en plusieurs fichiers.
Je joins mon fichier. Je cherche & découper mon fichier selon plusieurs possibilités : soit une découpe par RRH (colonne A), soit par Manager ( colonne B) soit par société (colonne E). Après le découpage je souhaiterais récupérer plusieurs fichiers qui seraient enregistrés dans le même dossier que le fichier source.
J'ai essayé de bidouiller plusieurs macros mais je n'arrive pas à mes fins.
Je suis preneuse de toute aide
D'avance, un grand merci !
Bonjour Avrilae,
D'une part, il faut choisir ce que tu veux faire...
D'autre part, sans données, il n'y a rien à découper !
Cordialement.
Bonjour,
Merci pour ta réponse rapide.
Alors partons sur un découpage par RRH (colonne A).
Je joins un fichier avec quelques données.
D'avance un grand merci !!!
Bonjour,
Ton cas étant relativement simple, il n'est pas utile de mobiliser le même arsenal que pour le sujet de référence. Ce qui complique un peu est ton en-tête avec cellules fusionnées.
On va donc traiter ton en-tête à part et la reproduire par copier-coller ordinaire qui répercutera sa mise en forme.
Sub GénérerClasseurs()
Dim aa, rh, ln, RRH(), plgET As Range, chD$, k%, n&, i&, d As Object
With ActiveSheet
i = .Range("A" & .Rows.Count).End(xlUp).Row
If i <= 13 Then Exit Sub
k = .Cells.SpecialCells(xlCellTypeLastCell).Column
aa = .Range("A13:A" & i).Resize(, k).Value
Set plgET = .Range("A8:A12").Resize(, k)
End With
chD = ThisWorkbook.Path & "\"
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aa)
d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
Next i
Application.ScreenUpdating = False
For Each rh In d.keys
ln = Split(d(rh), ";"): n = UBound(ln)
ReDim RRH(1 To n)
For i = 1 To n
RRH(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
Next i
With Workbooks.Add(xlWBATWorksheet)
With .Worksheets(1)
plgET.Copy .Range("A1")
With .Range("A6").Resize(n, k)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(RRH))
.Borders.Weight = xlThin
End With
End With
.SaveAs chD & rh & ".xlsx"
.Close
End With
Next rh
End Sub
La méthode consiste donc à :
1) Sur la feuille, on relève les dimensions de ton tableau en ligne et colonne, on récupère en tableau (aa) la plage de données (à partir ligne 13), on affecte l'en-tête à une variable Range (plgET), et note qu'on conserve la dimension colonne (k) qui ne variera pas pour les classeurs résultant.
On recueille aussi le chemin du classeur dans une variable (chD)
On peut alors continuer sur tableau...
2) On initialise un dictionnaire dont chaque élément sera par un RRH destiné à générer un classeur dédié.
On parcout le tableau de données pour constituer ce dictionnaire : pour chaque élément RRH on concatène les numéros de lignes concernées du tableau, séparés par des points-virgules.
3) On passe à la phase création de classeurs (désactivation de la mise à jour de l'affichage, car là ce qu'on va faire aura des effets visibles...)
Boucle sur chaque élément dico : chaque tour de boucle donnera lieu à création d'un classeur.
Pour chaque élément dico (sa clé : rh constitue le nom du futur classeur) :
- on récupère en tableau (ln) la liste à prélever dans le tableau de données pour le classeur à constituer [ce tableau comporte un élément 0 vide, on parcourra donc les lignes de 1 à n (variable à laquelle on affecte l'indice maximal de ln) pour récupérer les données afférentes ;
- on dimensionne (1 à n) un tableau de résultats (RRH), auquel on va affecter les lignes prélevées dans le tableau de données (aa) ;
- on procède au prélèvement en utilisant la fonction Excel INDEX, qui nous permet de prélever la ligne entière pour l'affecter à un élément du tableau RRH (lequel n'est de ce fait qu'un tableau unidimensionnel, dont chaque élément contient lui-même un tableau, qui est une ligne de données) ;
- on crée un nouveau classeur, muni d'une seule feuille ;
- on reproduit sur cette feuille l'en-tête, par copier-coller ;
- on y affecte ensuite les données à la suite de l'en-tête, affectation directe du tableau RRH à la plage cible dimensionnée à la taille des données (au moyen des variables n et k), qui compte tenu de la nature de ce tableau (tableau unidimensionnel de tableaux) doit s'opérer par une double transposition (utilisant la fonction Excel Transpose).
NB- Si tu constates qu'à l'issue de l'opération l'en-tête du tableau source conserve un pourtour scintillant, tu pourras ajouter à la fin de la macro (avant End Sub) la ligne :
Application.CutCopyMode = False
qui l'éliminera (c'est à ça qu'elle sert...
Cordialement.
Magnifique !!! Merci beaucoup. J'ai économisé de longues heures de travail !!
J'ai 2 questions additionnelles :
- si je souhaite découper par la colonne B, que dois-je ajouter pour que la macro recopie également la colonne A (et pas uniquement les colonnes B à ... la fin du classeur...)
- Est-il possible d'ajouter le copier coller d'un onglet (qui lui ne sera pas modifié : onglet type mode d'emploi)
Si tu découpes sur B au lieu de A, la seule chose à modifier est :
For i = 1 To UBound(aa)
d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
Next i
en :
For i = 1 To UBound(aa)
d(aa(i, 2)) = d(aa(i, 2)) & ";" & i
Next i
NB- Si je l'avais fait au départ sur B, j'aurais nommé autrement les variables RRH() et rh, mais cela ne les empêchera nullement de fonctionner de la même façon...
Pour insérer une feuille provenant du classeur source dans chaque classeur :
- tu ajoutes une variable dans les déclarations, par exemple :
wsME As Worksheet
- tu l'initialises dans la première partie, de cette façon par exemple :
With ThisWorkbook
chD = .Path & "\"
Set wsME = .Worksheets("Memo") 'nom à adapter
End With
et tu réalisers l'insertion de copie (ce n'est pas précisément un copier-coller
With Workbooks.Add(xlWBATWorksheet)
With .Worksheets(1)
'...
End With
wsME.Copy after:=.Worksheets(1) 'ou before:=, au choix
.SaveAs chD & rh & ".xlsx"
.Close
End With
Cordialement.
Merci beaucoup MFerrand !!!! Non seulement tu nous donnes la solution mais aussi tu prends le temps d'expliquer.
Avrilae
Bonjour MFerrand,
Une dernière question (je l'espère
Voici le code obtenu (qui fonctionne !!!)
Sub DécoupageManager()
Dim aa, rh, ln, RRH(), plgET As Range, chD$, k%, n&, i&, d As Object, wsME As Worksheet, wsSAIS As Worksheet
With ThisWorkbook
chD = .Path & "\"
Set wsME = .Worksheets("Mode d'emploi")
Set wsSAIS = .Worksheets("Saisie")
End With
With ActiveSheet
i = .Range("A" & .Rows.Count).End(xlUp).Row
If i <= 13 Then Exit Sub
k = .Cells.SpecialCells(xlCellTypeLastCell).Column
aa = .Range("A13:A" & i).Resize(, k).Value
Set plgET = .Range("A1:A12").Resize(, k)
End With
chD = ThisWorkbook.Path & "\"
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aa)
d(aa(i, 2)) = d(aa(i, 2)) & ";" & i
Next i
Application.ScreenUpdating = False
For Each rh In d.keys
ln = Split(d(rh), ";"): n = UBound(ln)
ReDim RRH(1 To n)
For i = 1 To n
RRH(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
Next i
With Workbooks.Add(xlWBATWorksheet)
With .Worksheets(1)
plgET.Copy .Range("A1")
With .Range("A13").Resize(n, k)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(RRH))
.Borders.Weight = xlThin
End With
End With
wsME.Copy before:=.Worksheets(1)
wsSAIS.Copy after:=.Worksheets(1)
.SaveAs chD & rh & ".xlsx"
.Close
End With
Next rh
MsgBox "Découpage du fichier terminé !"
End Sub
Dans mon fichier, j'ai 3 feuilles :
- une feuille "Mode d'emploi" (feuille qui n'a pas à être modifiée)
- une feuille Data avec les données
- et je souhaiterai ajouter une feuille "Saisie" qui reprendrai les données de l'onglet Data (avec de nombreuses RechercheV...). L'idée de cette feuille est d'avoir un tableau un peu allégé versus la feuille source "Data"
J'ai réussi grace à ton aide à ajouter la feuille mode d'emploi. J'ai également inséré une feuille "Saisie" avec des formules liant l'onglet Saisie à l'onglet Data mais les formules du nouveau fichier font référence au fichier initial et non au résultat de la "découpe". Je ne suis pas sure que cela fonctionne en cas d'envoi du fichiers à des tiers.
Ma demande : comment inserer la feuille "Saisie" qui ne reprenne que les données de la feuille Data après découpage
Comment faire en sorte que les onglets conservent tous leur nom initial ?
J'espère être claire dans ma demande. J'ai joint mon fichier retravaillé.
D'avance un grand grand merci
Bonjour,
Il y a deux choses :
D'abord, si tu voulais faire un double découpage, RRH et Manager, chacun lancé par un bouton, la même procédure étant utilisable en faisant varier un paramètre, on ne duplique pas la procédure, c'est reproduire inutile un code identique !
Tu dotes la procédure d'un argument correspondant au paramètre à faire varier, et chacun des bouton lancera la procédure en lui passant une valeur différente de ce paramètre.
Dans la procédure, tu remplaces la valeur en dur du paramètre par le nom de l'argument, qui joue le même rôle qu'une variable, et le tour est joué !
Pour ta 2e question, généralement on expurge les feuilles exportées de formules pour éviter de créer des liens entre classeurs lors de cette opération. Mais je ne vois pas bien l'utilité de cette feuille... ?
Cordialement.
Bonjour,
L'interet de cette seconde feuille est d'avoir une synthèse avec les quelques éléments importants et ainsi éviter d'avoir un tableau avec 30 colonnes . L'idée est d'avoir une sorte de formulaire de saisie.
Est-ce possible ?
Merci
Bonjour,
Je ne vois pas très bien en quoi ça pourrait jouer le rôle de formulaire, surtout étant constituée à partir de formules...
Tu la constitues sans formule au départ, telle que tu la veux à l'arrivée, et tu peux l'exporter sans problème, mais je garde le sentiment que ça fait quelque peu doublon.
Cordialement.
Bonjour,
J'ai retravaillé mon fichier.
Pour mémoire il s'agit d'un fichier que j'envoie à des services Ressources Humaines pour qu'ils travaillent sur les augmentation de salaire. L'idée est qu'ils puissent redécouper le fichier (bouton accessible depuis l'onglet "Découpage").
Le découpage fonctionne très bien (j'ai bidouillé, ça ne doit pas être très académique mais cela fonctionne).
En revanche je suis confrontée à 2 soucis :
- est_il possible de conserver les formules qui apparaissent dans le corps de la feuille Données (formules sans lien avec d'autres feuilles) : c'est vraiment ma priorité puisque je souhaite que ce fichier puisse etre envoyé puis redécoupé par les destinataires tout en conservant les formules (j'aimerai que lorsqu'ils saisissent une augmentation, le nouveau salaire soit calculé).
Pour le moment seules les formules sur les 15 premières lignes sont conservées, mais les données découpées perdent leurs formules.
- est_il possible de conserver le format des nombre (nombre de décimales, séparateur de milliers, format, etc...), la largeur des colonnes, etc... ?
Voici le code que je souhaiterai modifier + fichier joint
Sub DécoupageRRH()
Dim aa, rh, ln, RRH(), plgET As Range, chD$, k%, n&, i&, d As Object, wsME As Worksheet, wsDATA As Worksheet, wsDECOUP As Worksheet
With ThisWorkbook
chD = .Path & "\"
Set wsME = .Worksheets("Mode d'emploi")
Set wsDATA = .Worksheets("Données")
Set wsDECOUP = .Worksheets("Découpage fichiers")
End With
With wsDATA
i = .Range("A" & .Rows.Count).End(xlUp).Row
If i <= 15 Then Exit Sub
k = .Cells.SpecialCells(xlCellTypeLastCell).Column
aa = .Range("A15:A" & i).Resize(, k).Value
Set plgET = .Range("A1:A14").Resize(, k)
End With
chD = ThisWorkbook.Path & "\"
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aa)
d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
Next i
Application.ScreenUpdating = False
For Each rh In d.keys
ln = Split(d(rh), ";"): n = UBound(ln)
ReDim RRH(1 To n)
For i = 1 To n
RRH(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
Next i
With Workbooks.Add(xlWBATWorksheet)
.Worksheets(1).Name = ("Données")
With .Worksheets(1)
plgET.Copy .Range("A1")
With .Range("A15").Resize(n, k)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(RRH))
.Borders.Weight = xlThin
End With
End With
wsME.Copy before:=.Worksheets(1)
wsDECOUP.Copy before:=.Worksheets(1)
.SaveAs chD & rh & ".xlsx"
.Close
End With
Next rh
MsgBox "Découpage du fichier terminé !"
End Sub
D'avance merci pour vos réponses.
Bonjour,
J'ai avancé mais reste bloquée sur un point.
J'ai réussi à modifier le code afin de conserver toutes mes formules, ouf...
En revanche je n'arrive pas à faire en sorte que mes formats de nombre restent identiques. En gros j'aurais aimé utiliser la fonction "Reproduire la mise en forme" de ma feuille source vers le classeur nouvellement créé. Mais je ne vois pas du tout comment l'intégrer dans le code.
Avez-vous une solution ?
Ci-après le code & le fichier
Sub DécoupageRRH()
Dim aa, rh, ln, RRH(), plgET As Range, chD$, k%, n&, i&, d As Object, wsME As Worksheet, wsDATA As Worksheet, wsDECOUP As Worksheet
With ThisWorkbook
chD = .Path & "\"
Set wsME = .Worksheets("Mode d'emploi")
Set wsDATA = .Worksheets("Données")
Set wsDECOUP = .Worksheets("Découpage fichiers")
End With
With wsDATA
i = .Range("A" & .Rows.Count).End(xlUp).Row
If i <= 16 Then Exit Sub
k = .Cells.SpecialCells(xlCellTypeLastCell).Column
aa = .Range("A16:A" & i).Resize(, k).FormulaR1C1
Set plgET = .Range("A1:A15").Resize(, k)
End With
chD = ThisWorkbook.Path & "\"
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aa)
d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
Next i
Application.ScreenUpdating = False
For Each rh In d.keys
ln = Split(d(rh), ";"): n = UBound(ln)
ReDim RRH(1 To n)
For i = 1 To n
RRH(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
Next i
With Workbooks.Add(xlWBATWorksheet)
.Worksheets(1).Name = ("Données")
With .Worksheets(1)
plgET.Copy .Range("A1")
With .Range("A16").Resize(n, k)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(RRH))
.Borders.Weight = xlThin
End With
End With
wsME.Copy before:=.Worksheets(1)
wsDECOUP.Copy before:=.Worksheets(1)
.SaveAs chD & rh & ".xlsx"
.Close
End With
Next rh
MsgBox "Découpage du fichier terminé !"
End Sub
Merci pour votre aide.
Avrilae