fusion de fichiers excel en un seul fichier

Bonjour,

je voudrais fusionner plusieurs fichiers excel (de taille différente) en un seul fichier. Je suis très débutante en macro...

J'ai trouvé le code ci-dessous sur le net qui semblait fonctionner pour certains. Cette macro correspond théoriquement à ce que je veux :
ouvrir tous les fichiers .xls d'un fichier blabla, copier les cellules et les coller dans un fichier excel ouvert à cet effet.

Mais j'ai deux problèmes :
- cette macro permet bien d'ouvrir les fichiers d'un certain répertoire, de sélectionner, de fermer les fichiers mais au final, rien ne s'inscrit dans mon fichier final... ?
- autre problème (moins grave) : c'est un peu laborieux de devoir nommer les plages que je souhaite copier "plage_nommee". y-a-t-il moyen de faire plus simple ?

un grand merci !

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Range("A1").Select 'sélectionner la cellule de début Chemin = "C:blabla\" 'saisir le chemin complet du dossier où se trouvent les fichiers Fichier = Dir(Chemin & "*") ' 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

---

Bonjour,

Par rapport à "plage_nommee", as-tu une idée précise des cellules que tu dois copier ? Si ta plage commence en A1, tu peux faire ceci :

Code:

---

1 2 3

ligne = Range("A65536").End(xlUp).Row colonne = Cells(ligne, 255).End(xlToLeft).Column Range(Cells(1, 1), Cells(ligne, colonne)).Select

---

Pour ton fichier final, il manque tout simplement la sauvegarde, à savoir :

Code:

---

ThisWorkbook.Save

---

Autre chose, la méthode que tu utilises essaie d'ouvrir tous les fichiers du répertoire blabla, ok tant que les fichiers sont ceux que tu veux fusionner. Si tu as d'autres fichiers différents d'Excel, la macro essaiera de les ouvrir quand même. Il faudrait donc ajouter un filtre du type :

Code:

---

1 2 3 4 5 6

Do While fichier <> "" If Format(Right(fichier, 3), "<") = "xls" Then ' ..... le code End If fichier = Dir ' Fichier suivant Loop

---

Enfin, si un fichier pointe sur un graphique, tu auras droit à une erreur à

Code:

---

Range("A1:F10").Copy

---

Si la feuille à copier est la première, tu peux ajouter ceci :

Code:

---

1 2	Worksheets(1).Select Range("A1:F10").Copy

---

Voilà, je pense avoir fait le tour du problème ...
Bonne soirée,

Didier

Ca ne fonctionne toujours pas. J'imagine que je ne mets pas au bon endroit le "ThisWorkbook.Save".
En effet, les données de chaque fichier ont l'air de s'inscrire sur le nouveau fichier mais disparaissent aussitôt.

Peux-tu me préciser où il faudrait que je place cette instruction ?
Merci.

bonjour,


pourrai tu nous mettre ton code .. voir ou tu en est ..

Didier ta apporté quelques solutions , qu'il faudrai peu-être revoir.., je n'aime pas tout ce qui est select et activate... c'est à proscrire.. sauf si tu veux faire de l'animation en bougeant ton curseur dans tes classeurs..;

pour le Dir il y as plus simple tu peu mettre le filtre dans le premier appel à dir :

Code:

---

Fichier = Dir(Chemin & "*.xls") ' Premier fichier

---

enléve ensuite tes Activate.

Le Save tu dois le faire à la fin de ta boucle ... aprés le Loop

Pour éviter les Active, Activate, ActiveWorkbook, utilise une variable Classeur dans la quelle tu stocke une référence au classeur ouvert puis dans la suite de ton code utilise cette variable pour accéder au classeur :

Code:

---

1 2 3 4 5 6 7 8 9 10

Dim yaWk as workbook ... ... set yaWk= Workbooks.Open( Filename:=Chemin & Fichier)   'Par exemple pour Accéder à une cellule MsgBox yaWk.Sheets("Feuil1").range("A1") 'pour fermer le classeur yaWk.close false 'Ferme sans sauver ..

---

et lorsque tu veux accéder à une cellule du classeur contenant ta macro pas besoin de l'activer tu utilise ThisWorkbook

Code:

---

1 2	msgbox ThisWorkBook.sheets("Feuil1").range("A1")

---

Merci pour votre aide à tous les deux.
Malgré tout, je ne m'en sors pas : pour l'instant je ne cherche pas à améliorer l'écriture mais à ce que ça marche, ce que je n'arrive pas à faire ;-(
J'ai fait une seule macro pour l'instant donc je suis très débutante (et non informaticienne) : n'hésitez pas à détailler ;-) Désolée.

Voilà ce que je fais : j'ouvre un nouveau classeur et je lance ma macro (ci-dessous).
Chaque fichier .xls s'ouvre, les données se copient dans le nouveau classeur puis disparaissent du nouveau classeur et le fichier se referme...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Range("A1").Select 'sélectionner la cellule de début Chemin = "C:blabla\" '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 ThisWorkbook.Save End Sub

---

Citation:

---

Envoyé par croset

... pour l'instant je ne cherche pas à améliorer l'écriture mais à ce que ça marche, ..

---

l'amélioriation de l'écriture c'est pas pour faire jolie c'est aussi pour que cela marche !!!

tiens ta boucle modifiée , pense à modifier le nom des feuilles concernées:

Code:

---

1 2 3 4 5 6 7

Do While Fichier <> "" Set yaWk = Workbooks.Open(Filename:=Chemin & Fichier) yaWk.Sheets(1).Range("plage_nommee").Copy ThisWorkbook.Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0) yaWk.Close False Fichier = Dir ' Fichier suivant Loop ThisWorkBook.save

---

peu etre qu'il faut lui dire dans quel classeur copier la plage nommee

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Range("A1").Select 'sélectionner la cellule de début Chemin = "C:blabla\" '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").Copyremplace cette ligne par les 2 suivante Range("plage_nommee").Select Selection.Copy ThisWorkbook.Activateici donne le nom de la cible Windows("Fichier destinataire").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 ThisWorkbook.Save End Sub

---

Citation:

---

l'amélioriation de l'écriture c'est pas pour faire jolie c'est aussi pour que cela marche !!!

---

Ok. Désolée.

JackOuYA : j'ai essayé ce que tu proposes. Ca provoque toujours le même phénomène : les données, fichier après fichier, s'inscrivent puis disparaissent...

youki94 : merci pour cette proposition mais ça ne fonctionne pas non plus. Le même problème perdure...

:koi:


tiens rajoute l'instruction stop :

Code:

---

1 2 3 4

ThisWorkbook.Save stop End Sub

---

puis dis nous si à ce moment la les données de toutes tes feuilles sont bien présente sur ta feuille récap ..

Citation:

---

tiens rajoute l'instruction stop :

---

Cela fait comme d'habitude (inscription une fraction de seconde puis disparition). Mais en plus il y a un bogue puisque, après avoir lancé la macro, la fenetre de visual basic s'ouvre et il y a un "point d'arrêt" (flèche jaune) sur le stop...

PS: j'ai fait l'essai avec les deux codes (celui de JackOuYA et le "mien" amélioré). Je propose dorénavant de ne travailler que sur celui de JackOuYA à savoir :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Range("A1").Select 'sélectionner la cellule de début Chemin = "C:\Documents and Settings\mc\Bureau\Essai\" 'saisir le chemin complet du dossier où se trouvent les fichiers Fichier = Dir(Chemin & "*.xls") ' Premier fichier Do While Fichier <> "" Set yaWk = Workbooks.Open(Filename:=Chemin & Fichier) yaWk.Sheets(1).Range("plage_nommee").Copy ThisWorkbook.Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0) yaWk.Close False Fichier = Dir ' Fichier suivant Loop ThisWorkbook.Save Stop End Sub

---

le stop c'est pas un bug, c'est l'instruction qui permet de mettre un point d'arrêt dans le code.. le but d'arrêter la c'est pour être sur que tes données ne sont pas effacé aprés..

tu dis " (inscription une fraction de seconde puis disparition)" .. cette inscription ce fait bien dans le classeur où tu à écrit ton code , sur la feuil1 ..?

Citation:

---

tu dis " (inscription une fraction de seconde puis disparition)" .. cette inscription ce fait bien dans le classeur où tu à écrit ton code , sur la feuil1 ..?

---

oui.

bon met le stop au début.. avant l'ouverture du classeur à copier, puis exécute le code pas à pas (touche F8) et entre chaque pas regarde ce qui se passe sur la feuille destinataire...

:koi: je comprends pas commment la copie disparait..:aie:

Merci pour cette idée car j'avais tout faux !
En fait, les fichiers s'ouvrent et se referment mais sans rien copier sur le nouveau classeur.
J'avais l'impression visuelle que ca se copiait. Désolée.
J'ai essayé avec "mon" code. Pareil.

Donc pour résumer : ça ne copie rien dans le nouveau classeur.

Bon maintenant il faut tous nous dire :mouarf:


il y as quoi avant la ligne inutile :

Code:

---

Range("A1").Select 'sélectionner la cellule de début

---

montre nous le code au dessus de cette ligne entre sub ... et cette ligne .

Rien, selon moi ... ;-)
Voilà exactement ce qu'il y a :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Sub ResultatSpecifique() ' ' ResultatSpecifique Macro ' Macro enregistrée le 15/11/2008 par Croset ' Range("A1").Select 'sélectionner la cellule de début Chemin = "C:\Documents and Settings\mc\Bureau\Essai\" 'saisir le chemin complet du dossier où se trouvent les fichiers Fichier = Dir(Chemin & "*.xls") ' Premier fichier Do While Fichier <> "" Set yaWk = Workbooks.Open(Filename:=Chemin & Fichier) yaWk.Sheets(1).Range("plage_nommee").Copy ThisWorkbook.Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0) yaWk.Close False Fichier = Dir ' Fichier suivant Loop ThisWorkbook.Save Stop End Sub

---

eu... le stop n'est plus utile...

le seul truc que je vois ... qui pourrai resté , cet une erreur sur ta plage nommée... ?

peu-tu les contrôler..? elles contient combien de cellules ?

Pour le stop, c'était déjà supprimé. Merci.

Pour les plages nommées. Peut-être ais-je en effet tout faux...
J'ai fait insertion->Nom->Definir.
Et là j'ai donné la plage que je voulais copier (qui correspond à l'ensemble des cellules).
C'est bien ça ?

Citation:

---

(qui correspond à l'ensemble des cellules)

---

toutes les cellules de ta feuille ?

elles sont organisé comment les donnés que tu veux copier ?

La premiére colonne est-elle toujours renseignée ?

En fait, à l'origine, ce sont des fichiers .csv

Il y a des données sur une dizaine de colonnes (dès la première) et plusieurs centaines de lignes...
J'ai nommé "plage_nommee" l'ensemble des cellules non vides.