Fusionner plusieurs fichiers excels en un seul [Résolu]

Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
- - Dernière réponse : JM13nouveau
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
- 8 déc. 2009 à 18:33
Bonjour,
j'ai plusieurs fichiers excels je dois les fusionner en un seul. chaque fichier contient plusieurs feuilles.
j'ai essayer plusieurs macro en vba mais pour l'instant je n'ai pas réussi

voici un code que j'ai utilisé entre autre:
Sub essai()
Dim Fich As String, Ligne As Double
Fich = Dir("C:\chemin\*.xls")
Do While Fich ""
Ligne = Range("a65536").End(xlUp).Row + 1
Workbooks.Open "C:\chemin" & Fich
Range("A3", Range("H65536").End(xlUp)).Copy _
ThisWorkbook.Sheets(1).Cells(Ligne, 1)
ActiveWorkbook.Close False
Fich = Dir
Loop
End Sub

il me donne erreur syntaxe

quelqu'un peut m'aider svp, me renseigner ou bien, me dire c'est quoi l'erreur

merci d'avance
Afficher la suite 

11 réponses

Meilleure réponse
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
3
Merci
Voici je partage cette macro qui permet de fusionner plusieurs fichiers excels (chacun 3 feuilles) en un seul fichier ( 1 seule feuille).

le fichier compilateur doit être dans le même dossier des autres fichiers à fusionner.

merci pour l'aide de tout le monde.

le code:

Sub LaunchCompilation()
' Ce code doit servir à regrouper les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur

Application.DisplayAlerts = False ' pour éviter les message demandant confirmation lors d'une fermeture (notamment le fait d'avoir des données dans le presse papier
chemin = ThisWorkbook.Path 'chemin du dossier qui contient les autres fichiers et où est enregistré ce fichier qui servira de compilateur
Set fso = New FileSystemObject 'l'utilisation des FSO nécessite l'activation de la référence Microsoft Scripting Runtime
Set dossier = fso.GetFolder(chemin) '
Dim r As Integer ' r sera le n° de la ligne de la feuille compilateur
r = 1
Dim nbfichiers ' nbfichier sera le nombre de fichiers traités
nbfichier = 0
Dim listedesfichierstraités As String

For Each fichier In dossier.Files ' boucle sur les fichiers
If fso.GetExtensionName(fichier.Path) = "xls" And fichier.Name <> ThisWorkbook.Name Then 'sélection des fichiers à traiter : classeurs excel et pas le compilateur
nbfichiers = nbfichiers + 1
listedesfichierstraités = listedesfichierstraités & fichier.ShortName & Chr(10)
Workbooks.Open fichier 'ouverture d'un fichier

For i = 1 To ActiveWorkbook.Sheets.Count ' boucle sur les feuilles de ce fichier
Sheets(i).Select 'sélection de la feuille


Select Case i
Case 1
lastrow1 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
Range(Cells(1, 1), Cells(lastrow1, 4)).Copy 'copie des cellules de la plage A1:D dernière ligne
ThisWorkbook.Activate 'on se place sur le fichier de compilation
Sheets(1).Cells(r, 1).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne A
ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
Case 2
lastrow2 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
Range(Cells(1, 1), Cells(lastrow2, 6)).Copy 'copie des cellules de la plage A1:F dernière ligne
ThisWorkbook.Activate 'on se place sur le fichier de compilation
Sheets(1).Cells(r, 5).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne E
ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
Case 3
lastrow3 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C
Range(Cells(1, 1), Cells(lastrow3, 3)).Copy 'copie des cellules de la plage A1:C dernière ligne
ThisWorkbook.Activate 'on se place sur le fichier de compilation
Sheets(1).Cells(r, 11).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne K
ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial
End Select
Cells(r, 1).EntireRow.Interior.ColorIndex = 1


Workbooks(fichier.Name).Activate
Next i

If lastrow1 > lastrow2 And mastrow1 > lastrow3 Then
lastrow = lastrow1
Else
If lastrow2 > lastrow1 And lastrow2 > lastrow3 Then
lastrow = lastrow2
Else
lastrow = lastrow3
End If
End If

r = r + lastrow 'on ajoute à r la dernière ligne pour toujours se placer sur la 1ère cellule vide de la colonne A


Workbooks(fichier.Name).Close (False) 'on ferme le fichier ouvert précédemment
End If
Next fichier
Application.DisplayAlerts = True 'on rétablie le paramétrage standard
Cells(1, 1).Select
MsgBox ("Le traitement est terminé." & Chr(10) & nbfichiers & " fichiers ont été traités, en voici la liste :" & Chr(10) & listedesfichierstraités)
End Sub

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 126 internautes nous ont dit merci ce mois-ci

Commenter la réponse de JM13nouveau
Messages postés
181
Date d'inscription
mardi 18 novembre 2008
Statut
Membre
Dernière intervention
4 février 2011
0
Merci
Hello,

Que veux-tu faire exactement :
- 1 feuille reprenant les données de X autres feuilles réparties dans X fichiers ?
- 1 classeur reprenant toutes les feuilles des X autres classeur ?

BR

USERRRQI115
Simple user
Great brain
Commenter la réponse de userrrqi115
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
0
Merci
hello,

effectivement 1 feuille reprenant les données de X feuilles réparties dans X classeurs

si non la deuxième je sais faire

merci bcp pr ton aide
Commenter la réponse de JM13nouveau
Messages postés
181
Date d'inscription
mardi 18 novembre 2008
Statut
Membre
Dernière intervention
4 février 2011
0
Merci
Re,

chemin = "D:\TEST"
Set fso = New FileSystemObject
Set dossier = fso.GetFolder(chemin)
r = 1
For Each fichier In dossier.Files

If fichier.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=fichier
Workbooks(fichier.Name).Activate
For i = 1 To ActiveWorkbook.Sheets.Count
Sheets(i).Select
lastline = Range("A65536").End(xlUp).Row
Range(Cells(1, 1), Cells(lastline, 8)).Copy
ThisWorkbook.Activate
Cells(r, 1).Select
ActiveSheet.Paste
r = r + lastline
Workbooks(fichier.Name).Activate
Next i
ActiveWorkbook.Close (False)
End If

Next fichier

'
End Sub


Cet exemple permet de compiler sur le fichier qui contient le code les données des colonnes A à H (dernière ligne pour cellule en A non vide).

BR
USERRRQI115
Simple user
Great brain
Commenter la réponse de userrrqi115
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
0
Merci
hello,

j'ai appliqué ton code il me dit:

erreur de compilation,

type défini par l'utilisateur non défini

Set fso New FileSystemObject selectioonne ca en bleu
Set dossier fso.GetFolder(C:\Documents and Settings\adm\Bureau\NouveauDossier) ca en rouge

et me dit aussi attendu seperateur ou)

la j'ai ce 2 types d'erreurs

j'ai essayé de mettre \\ a la place de \

mais bon,

est ce que t'as une idée d'où ça vient

merci bcp pr ton aide
Commenter la réponse de JM13nouveau
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
0
Merci
Re, j'ai remis les choses ds l'ordre

Set fso = New FileSystemObject
Set dossier = fso.GetFolder(chemin)
r = 1
For Each fichier In dossier.Files

j'ai l'impression que ca vient tjrs de la première ligne :
Set fso = New FileSystemObject

sauf un truc que j'ai pas compris : In dossier.Files

si tu peux me dire la faute vient d'ou?

ca sera sympa

merci bcp pr ton aide
Commenter la réponse de JM13nouveau
Messages postés
181
Date d'inscription
mardi 18 novembre 2008
Statut
Membre
Dernière intervention
4 février 2011
0
Merci
Oups,
j'ai oublié : il faut ajouter la référence Microsoft Scripting Runtime au projet (fenêtre VBA, Outils et Références)
Sorry
BR

USERRRQI115
Simple user
Great brain
Commenter la réponse de userrrqi115
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
0
Merci
re,

cad la je te suis pas !!

comment!

merci
Commenter la réponse de JM13nouveau
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
0
Merci
re,

j'ai refais ça donc j'ai executer la macro , pr l'instant je n evois pas difference ?

des explications

merci bcp!!
Commenter la réponse de JM13nouveau
Messages postés
181
Date d'inscription
mardi 18 novembre 2008
Statut
Membre
Dernière intervention
4 février 2011
0
Merci
Bizarre
as-tu essayer de sauvegarder , d'ouvrir à nouveau le fichier et vérifier que la référence est cochée ?
Si ça marche toujours pas, envoie moi ton email et je t'envoie mon fichier qui fonctionne.
BR


USERRRQI115
Simple user
Great brain
Commenter la réponse de userrrqi115
Messages postés
19
Date d'inscription
vendredi 3 avril 2009
Statut
Membre
Dernière intervention
22 mars 2010
0
Merci
Bonjour,

effectivement j'ai bien vérifié que la référence est coché j'ai enregistré et fermé, j'ai réouvert et pas différence!

merci bcp pr ton aide

mass747@hotmail.com
Commenter la réponse de JM13nouveau