Macro pour fusion de plusieurs fichier dans 1 [Résolu/Fermé]

Messages postés
17
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
22 août 2008
- - Dernière réponse : juer31
Messages postés
98
Date d'inscription
mercredi 16 décembre 2015
Statut
Membre
Dernière intervention
28 mai 2019
- 17 avril 2019 à 21:30
Bonjour,

j'ai 16 fichiers excel est il possible via une macro de copier toutes les lignes des 16 fichiers et les copiers les une en dessous des autres dans un seul fichier.

Merci pour votre aide.
Afficher la suite 

9 réponses

Meilleure réponse
Messages postés
15647
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
8843
35
Merci
Bonjour,

Si tous tes classeurs ont la même structure, oui ce n'est pas très compliqué. La macro va ouvrir chaque classeur puis copier-coller... Il y a une solution qui permet d'aller directement dans les classeurs sans les ouvrir et qui passe par ADO, mais c'est prise de tête et ça fonctionne... moyen... en fonction des types de données.

Tu peux essayer cette macro toute simple, tu verras, c'est très rapide. Tes fichiers source doivent être fermés et tous dans le même dossiers, la macro doit se trouver dans le fichier destination.

Sub recup()
Range("A1").Select    'sélectionner la cellule de début
Chemin = "c:\Mes documents\..."     'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
    Workbooks.Open Filename:=Chemin & Fichier
    Range("bd_export").Copy
    ThisWorkbook.Activate
    ActiveSheet.Paste
    Windows(Fichier).Activate
    Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Fichier = Dir ' Fichier suivant
Loop
End Sub

Dire « Merci » 35

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 62979 internautes nous ont dit merci ce mois-ci

yolandeh
Messages postés
1
Date d'inscription
samedi 10 août 2013
Statut
Membre
Dernière intervention
10 août 2013
-
Bonjour à vous
j'ai des fichiers mensuelles de données qui sont enrégistrés chaque mois dans un même dossier que je souhaite fusionner de facon chronoligue( janvier fev mars avril.....) et ensuite j'aimerais que le fichier se mette à jour automatiquement dés qu'il y a un nouveau mois tout en supprimant les en têtes de colones. J'ai essayé le code de Marina. Mais rien ne passe. je suis tres novice. Besoin de votre aide. Merci d'avance
Salut Marina, j'ai essayé ton code VBA posté au début mais j'ai eu une erreur :( ,je veux consolider plusieurs classeurs dans un seul global

<code basic>
Sub recup()
Range ("A1")
Chemin = "C:\Users\Sony\Desktop\MesMacros\prof"
Fichier = Dir(Chemin & "*.xlsx")
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("bd_export").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop<code>

</code>
</code>
Merci de m'indiquer l'erreur stp^^
Cordialement,
Lynda
m@rina
Messages postés
15647
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
8843 -
Bonsoir,

Tu ne dis pas à quel endroit se déclenche l'erreur, ni quelle est cette erreur.
Cela dit, il manque le \ à la fin du chemin :
"C:\Users\Sony\Desktop\MesMacros\prof\"

m@rina
Je viens de tester sa et sa fonctionne, si je voudrais ajouter le nom du fichier entre chaque copie collé, est-ce possible?
juer31
Messages postés
98
Date d'inscription
mercredi 16 décembre 2015
Statut
Membre
Dernière intervention
28 mai 2019
6 -
Merci
Messages postés
15647
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
8843
4
Merci
Bonjour,

Si tous tes classeurs ont la même structure, oui ce n'est pas très compliqué. La macro va ouvrir chaque classeur puis copier-coller... Il y a une solution qui permet d'aller directement dans les classeurs sans les ouvrir et qui passe par ADO, mais c'est prise de tête et ça fonctionne... moyen... en fonction des types de données.

Tu peux essayer cette macro toute simple, tu verras, c'est très rapide. Tes fichiers source doivent être fermés et tous dans le même dossier, la macro doit se trouver dans le fichier destination.
Les plages à exporter doivent être nommées dans chaque fichier source.

Sub recup()
Range("A1").Select 'sélectionner la cellule de début
Chemin = "c:\Mes documents\..." 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("plage_nommee").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub

m@rina
KER@
Messages postés
1
Date d'inscription
vendredi 18 novembre 2011
Statut
Membre
Dernière intervention
18 novembre 2011
-
J'ai recuperé votre marcro mais j'ai une erreur à l'execution
Erreur execution 9 , l'indice n'appartient à la plage des données.
pouvez m'aider à avancer?
bonjour,

je débute en VBA et macro et j'aimerais compiler une vingtaine de fichiers excel en 1 seul (lignes à la suite les unes les autres)
j'ai copié votre macro mais rien ne se passe, je crois que je n'ai pas modifié où il faudrait...

Merci d'avance pour votrre aide !

CB
Messages postés
15647
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
8843
1
Merci
Bonjour,

Si tous tes classeurs ont la même structure, oui ce n'est pas très compliqué. La macro va ouvrir chaque classeur puis copier-coller... Il y a une solution qui permet d'aller directement dans les classeurs sans les ouvrir et qui passe par ADO, mais c'est prise de tête et ça fonctionne... moyen... en fonction des types de données.

Tu peux essayer cette macro toute simple, tu verras, c'est très rapide. Tes fichiers source doivent être fermés et tous dans le même dossiers, la macro doit se trouver dans le fichier destination.

Sub recup()
Range("A1").Select 'sélectionner la cellule de début
Chemin = "c:\Mes documents\..." 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("bd_export").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub
Messages postés
10
Date d'inscription
vendredi 23 janvier 2009
Statut
Membre
Dernière intervention
25 janvier 2009
1
1
Merci
Fusion de plusieurs fichiers excel en un seul

Bonjour,
Je dois moi aussi faire une fusion de données en un seul fichier.
En effet je suis en stage chez un operateur mobile et on me demande de créer un fichier excel a partir des differentes transactions .csv (plus de 1000).
j' ai bau appliqué le code de Marina, mais voila rien ne se passe et en mode debogage la compilation reste bloquée à la 3 eme ligne. Aidez moi a trouver le probleme de plus j ai des contraintes de temps :-(
Merciiiii.
Messages postés
17
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
22 août 2008
1
0
Merci
salut marina,

merci pour le temps que tu m'accordes,

J'ai essayé ton code et rien ne se passe quand je l'exécute, j'ai fais les modifs des chemin de mes fichiers mais toujours rien.
De plus d'un mois à l'autres je n'ai pas le même nombre de ligne alors est il possible de copier les données sans nommer la zone à exporter et pour les coller dans le fichier de destination coller le 2 ème fichier a la première ligne vide du 1er fichie.

Voila pour mes interrogations et merci pour tes idées...
m@rina
Messages postés
15647
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
8843 -
Bonjour,

Il n'y a aucune raison que cette macro ne fonctionne pas... Testé...

As-tu nommé les plages dans tes fichiers ?

Si le nombre de lignes changent régulièrement, ce qui me paraît normal, il suffit de mettre des noms avec la formule DECALER. Ainsi peu importe le nbre de lignes, la plage sera toujours OK.

m@rina
Messages postés
17
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
22 août 2008
1
0
Merci
salut,

maintenant le code s'exécute mais il ne m'ouvre pas tous les fichiers du dossier.
j'ai pas nommé les plages je vais le faire mais je ne comprend pas comment utiliser la formule DECALER ou je dois la mettre?
et est ce qu'ensuite les fichier se colleront les un en dessous des autres.


Sub recup()
Range("A1").Select 'sélectionner la cellule de début
Chemin = "K:\1- EPC\BUDGETS\BUDGET 2008\Retours marges\07 NS\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "04848 marge.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Rows("1:25").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Range("plage_nommee").Copy <-------- je vais nommer les plages
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub
Messages postés
15647
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
6 décembre 2019
8843
0
Merci
Bonjour,

Faut pas modifier la macro, à part donner le nom du chemin complet et le nom de la plage.

Supprime :
Fichier = Dir(Chemin & "04848 marge.xls") ' Premier fichier

et remets ce que j'ai mis à l'origine :
Fichier = Dir(Chemin & "*.xls") '

sinon, ça t'ouvre juste le premier fichier dont tu as mis le nom en dur !

Pourquoi veux tu supprimer ces lignes ?
Rows("1:25").Select
Selection.Delete Shift:=xlUp

pour mettre une formule DECALER pour nommer les noms, voici ce que tu peux mettre, supposant que
- il y ait 10 colonnes et que ce nombre ne changera pas
- la feuilles où se trouvent les données se nomme BASE
- les données commencent en ligne 2 (en effet, on ne veut pas récupérer les lignes d'entêtes des 20 classeurs)

=DECALER(BASE!$A$2;;;(NBVAL(BASE!$A:$A)-1);10)

Juste une précision importante : prend pour calcul NBVAL la colonne qui sera forcément remplie et pas une colonne qui peut avoir des cellules vides. Ici j'ai mis par défaut la première $A:$A mais ce peut etre n'importe quelle autre.

m@rina
benben82
Messages postés
17
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
22 août 2008
1 -
salut,

alors j'avais sali ton code, j'ai remi en place ton code et il fonctionne très bien, je t'en remercie
Pourquoi veux tu supprimer ces lignes ? car j'ai seulement besoin des données sans les entêtes

j'ai une interrogations je ne comprend pas l'utilité de =DECALER avec ce code les données des différents fichiers se mettent automatiquement à la suite (je crois!!!) , et si j'en ai besoin il faut la mettre ou dans quelle cellule?

merci beaucoup marina tu m'as très bien assisté dans mes galère.

Range("A1").Select 'sélectionner la cellule de début
Chemin = "K:\1- EPC\BUDGETS\BUDGET 2008\Retours marges\07 NS\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Rows("1:25").Select
Selection.Delete Shift:=xlUp
Range("Zone_d_impression").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
'nommer onglet
Sheets("Feuil1").Name = "retour marge DMEI"

'enregistrement du fichier
ChDir "K:\1- EPC\BUDGETS\BUDGET 2008\Retours marges\07 NS\marge DMEI"
ActiveWorkbook.SaveAs Filename:= _
"K:\1- EPC\BUDGETS\BUDGET 2008\Retours marges\07 NS\marge DMEI\marge DMEI.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

End Sub
benben82
Messages postés
17
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
22 août 2008
1 -
salut marina,

tu as résolu mon problème de fusion mais j'ai un autre souci, je voudrai une ligne de code qui me permet de coller une données tant que la cellule (colonne C) d'après n'est pas vide.

voici le code

Sub recup()
Range("A26").Select
Chemin = "K:\1- EPC\BUDGETS\BUDGET 2008\Retours marges\07 NS\copie fichier retour marge\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("IV1").Select
Selection.ClearContents
Columns("B:B").Select
Selection.Insert Shift:=xlToRight

'trouver boucle pour pouvoir le faire tant qu'il n'y a pas de cellule vide
Range("C1").Select
Selection.Copy
Range("B26").Select '
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Rows("1:25").Select
Selection.Delete Shift:=xlUp
Range("Zone_d_impression").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop

End Sub
Messages postés
8714
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
24 novembre 2019
1028
0
Merci
Bonjour,
Marina, si tu permet une alternative ?
Sub CopieClasseur()
Dim fs, F, f1, s, sf
Dim Ext As String, Chemin As String
Dim T As String, Fin As Long
Dim FL1 As Worksheet
Dim FL2 As Worksheet
    Ext = "xls" :   Chemin = "G:\" 'à adapter
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    Set FL1 = Workbooks("Classeur2").Sheets("Feuil1") 'à adapter
    Fin = 1
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then 'pour être certain que c'est un classeur
            Workbooks.Open Chemin & f1.Name
            Set FL2 = ActiveWorkbook.Sheets("Feuil1")
            T = FL2.Range("A1").SpecialCells(xlCellTypeLastCell).Address
            FL2.Range("A1:" & T).Copy
            FL1.Activate
            Cells(Fin, 1).Activate
            ActiveSheet.Paste
            Fin = Fin + FL2.Range(T).Row
            Workbooks(f1.Name).Close SaveChanges:=False
            Set FL2 = Nothing
        End If
    Next
    FL1 = Nothing
End Sub

'ATTENTION Il faudra peut-être trouver un autre moyen pour
'trouver la dernière ligne pour T
'Si données toujours renseignées dans une colonne fixe changer par
'Range("A65536").End(xlUp).Row > avec A la lettre de la colonne.
A+
Messages postés
10
Date d'inscription
vendredi 23 janvier 2009
Statut
Membre
Dernière intervention
25 janvier 2009
1
0
Merci
Fusion de plusieurs fichiers excel en un seul

Bonjour,
Je dois moi aussi faire une fusion de données en un seul fichier.
En effet je suis en stage chez un operateur mobile et on me demande de créer un fichier excel a partir des differentes transactions .csv (plus de 1000).
j' ai bau appliqué le code de Marina, mais voila rien ne se passe et en mode debogage la compilation reste bloquée à la 3 eme ligne. Aidez moi a trouver le probleme de plus j ai des contraintes de temps :-(
Merciiiii.
bonjour,

peut être que l'erreur vient de l'extension de tes fichier (.csv)

il faudrai que tu modifis tes fichiers csv en fichier xls et ensuite tu pourra te servir du code ci-dessus et l'adapter à ta guise.

ou autrement comme extenssion csv il y a une solution pour les exporter avec la commande Dos je m'en souvien pas exactement mais j'avais vu sa sur un forum

A bientot