[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
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 SubJe 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
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 SubSi 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
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
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
Pas de problème.
Bye !