[VBA] Copier les feuilles de plusieurs classeurs en un seul

Bonjour à tous !

Alors je m'explique, j'aimerais faire en sorte de copier toutes les feuilles comprises dans plusieurs classeurs (en connaissant le nom des classeurs mais en ne connaissant pas le nom de toutes les feuilles) dans un seul et unique classeur.

Également, j'aimerais que les noms des feuilles ainsi créées soit de ce format : Nomduclasseurderéférence_Nomdelafeuillederéférence.

Est-il possible de faire tout ça en macro ?

Je vous mets un exemple en pièce-jointe :

Classeur de référence : Classeur1 & Classeur2

Classeur unique que j'aimerais obtenir : Classeur

Je vous remercie de l'aide que vous pourrez m'apporter.

Tuba

43exemple.zip (39.35 Ko)

Bonjour,

Vous n'auriez pas une idée pour résoudre cette question ?

Merci

Re,

Bon j'essaie un petit code :

Sub importer()
Dim a, b, c, d, e, f, g As String
Dim nomfichier1, nomfichier2 As String

a = "xxx\exemple\"  'où xxx est le lien vers mon dossier contenant tous mes fichiers
b = Sheets("Feuil1").Range("A2")
c = b & ".*"
d = a & c
ControlFile = ActiveWorkbook.Name

Workbooks.Open Filename:=d

ControlFile2 = ActiveWorkbook.Name
Workbooks(ControlFile2).Activate

Sheets(1).Select
Range("A1").Select
nomfichier1 = Sheets(1).Name

Workbooks(ControlFile2).Sheets(1).Copy , after:=Workbooks(ControlFile).Sheets("Feuil1")

Sheets(2).Select
Range("A1").Select
nomfichier2 = Sheets(2).Name

Workbooks(ControlFile2).Sheets(2).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier1)

ControlFile = ActiveWorkbook.Name
Workbooks(ControlFile2).Close

'fin de copiage du fichier 1

e = Sheets("Feuil1").Range("A3")
f = e & ".*"
g = a & f
ControlFile = ActiveWorkbook.Name

Workbooks.Open Filename:=g

ControlFile3 = ActiveWorkbook.Name
Workbooks(ControlFile3).Activate

Sheets(1).Select
Range("A1").Select
nomfichier3 = Sheets(1).Name

Workbooks(ControlFile3).Sheets(1).Copy , after:=Workbooks(ControlFile).Sheets("Feuil1")

Sheets(2).Select
Range("A1").Select
nomfichier4 = Sheets(2).Name

Workbooks(ControlFile3).Sheets(2).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier3)

Sheets(3).Select
Range("A1").Select
nomfichier5 = Sheets(3).Name

Workbooks(ControlFile3).Sheets(3).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier4)

ControlFile = ActiveWorkbook.Name

Workbooks(ControlFile3).Close

End Sub

Je suis loin de ce que j'aimerais (le code est très peu automatique, je peux pas faire ça pour 1500 fichiers excels..) et je n'arrive pas à modifier le nom des onglets quand je fais un copiage...

Si quelqu'un à une idée pour me faire avancer, ça serait cool

Merci beaucoup !

Tuba

30exemple2.zip (52.53 Ko)

Re,

Suis-je sur la bonne voie avec mon début de code ?

Merci

Tuba

Bonjour,

Après une nuit d'acharnement j'ai "réussi" à trouver le moyen de modifier le nom des feuilles que je vais coller, mais il n'y a rien d'automatiser....

Voici mon code :

Sub importer()
Dim a, b, c, d, e, f, g As String
Dim nomfichier1, nomfichier2, nomfichier10 As String

a = "xxx\exemple3\"  'où xxx est le lien vers mon dossier contenant tous mes fichiers
b = Sheets("Feuil1").Range("A2")
c = b & ".*"
d = a & c
ControlFile = ActiveWorkbook.Name

Workbooks.Open Filename:=d

ControlFile2 = ActiveWorkbook.Name
Workbooks(ControlFile2).Activate

'test de feuille

feuille1 = Sheets(1).Name
feuille2 = Sheets(2).Name

'selection de la première feuille

Sheets(1).Select
Range("A1").Select
nomfichier1 = b & "_" & feuille1

Workbooks(ControlFile2).Sheets(1).Copy , after:=Workbooks(ControlFile).Sheets("Feuil1")
Sheets(feuille1).Name = nomfichier1

'selection de la deuxième feuille

Sheets(2).Select
Range("A1").Select
nomfichier2 = b & "_" & feuille2

Workbooks(ControlFile2).Sheets(2).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier1)
Sheets(feuille2).Name = nomfichier2

'prendre le contrôle sur mon fichier principal et fermer le fichier ouvert

ControlFile = ActiveWorkbook.Name
Workbooks(ControlFile2).Close

'fin de copiage du fichier 1
'idem pour le classeur2

e = Sheets("Feuil1").Range("A3")
f = e & ".*"
g = a & f
ControlFile = ActiveWorkbook.Name

Workbooks.Open Filename:=g

ControlFile3 = ActiveWorkbook.Name
Workbooks(ControlFile3).Activate

feuille1 = Sheets(1).Name
feuille2 = Sheets(2).Name
feuille3 = Sheets(3).Name

Sheets(1).Select
Range("A1").Select
nomfichier3 = e & "_" & feuille1

Workbooks(ControlFile3).Sheets(1).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier2)
Sheets(feuille1).Name = nomfichier3

Sheets(2).Select
Range("A1").Select
nomfichier4 = e & "_" & feuille2

Workbooks(ControlFile3).Sheets(2).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier3)
Sheets(feuille2).Name = nomfichier4

Sheets(3).Select
Range("A1").Select
nomfichier5 = e & "_" & feuille3

Workbooks(ControlFile3).Sheets(3).Copy , after:=Workbooks(ControlFile).Sheets(nomfichier4)
Sheets(feuille3).Name = nomfichier5

ControlFile = ActiveWorkbook.Name

Workbooks(ControlFile3).Close

'fin de copiage du fichier 2

End Sub

Si quelqu'un connais un moyen d'automatiser un peu plus mon VBA (car je ne connais pas le nombre de feuilles dans tous mes classeurs, et écrire tout à la main me prendrais énormément de temps pour plus de 1500 fichiers...)

J'ai vraiment besoin d'aide svp..

Merci,

Tuba

22exemple3.zip (48.04 Ko)
24classeur.xlsm (19.29 Ko)
18classeur1.xlsx (13.69 Ko)
20classeur2.xlsx (14.27 Ko)

Bonjour

Un essai à tester.

Tous les fichiers doivent être dans un même dossier et seul le fichier "Classeur.xlsm" doit être ouvert.

Cela te convient-il ?

Bye l

122tuba.zip (37.31 Ko)
gmb a écrit :

Bonjour

Un essai à tester.

Tous les fichiers doivent être dans un même dossier et seul le fichier "Classeur.xlsm" doit être ouvert.

Cela te convient-il ?

Bye l

Merci gmb pour ta réponse !

Finalement j'ai essayé de me débrouiller et je suis arrivé à ce que je voulais obtenir !

Certes le code n'est pas beau du tout mais ça a l'air de fonctionner..

Éventuellement, si tu as un moyen de réduire ou simplifier le code je suis preneur

PS : Je t'ai pris ton bouton comme il était super beau si ça ne te déranges pas

Merci

Tuba

86final.zip (53.79 Ko)

Pas de problème.

Bye !

Rechercher des sujets similaires à "vba copier feuilles classeurs seul"