Fusionner tous les fichiers Excel appartenant à un dossier

Bonjour à tous,

Je ne parviens pas à copier les feuilles de différents fichiers Excel (.xlsx) appartenant à un même dossier dans un fichier mère (.xlsm).

Plus exactement tous mes fichiers .xlsx sont dans un dossier appelé DataPositions. Le code devrait pouvoir copier les feuilles de ces différents fichiers sans en connaître le nom, grâce au chemin du dossier. Finalement toutes les feuilles devraient apparaître dans le fichier mère "Aggregation.xlsm" et chacune de ces feuilles devrait porter le nom de son fichier d'origine (et non pas de sa feuille puisque la feuille de chaque fichier a le même nom, à savoir "pos"). Autrement dit si un fichier venait à s'appeler "XX.xlsx" je devrais avoir une feuille appelée XX dans le fichier mère "Aggregation.xlsm".

Pourriez-vous m'aider s'il vous plaît ?

J'ai commencé quelque chose mais je suis bloqué :

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

Path = "/Users/..............." 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
Wkb.Sheets("pos").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hello

Essaye comme ceci :

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

Path = "/Users/..............." 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do while len(FileName) > 0 
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For each La_Feuille in Wkb.worksheets.count
Wkb.Sheets(La_Feuille).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
next  La_Feuille 
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

R@g

Hello,

Merci beaucoup pour ce retour, malheureusement rien ne se passe visiblement sur le fichier mère "Aggregation.xlsm"... et pourtant aucune erreur n'apparaît lorsque le module est lancé. C'est un vrai casse tête.

Bonne journée

Hello,

Autant pour moi, il y avait des erreurs, fonctionnel chez moi :

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

Path = "C:\Users\DATAPOSITION\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do While Len(FileName) > 0
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
    WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

R@g

Hello,

Merci pour ce retour et pour ton temps. La macro semble tourner sans erreur mais aucune donnée n'est transférée sur le fichier mère "Aggregation.xlsm", j'ai vraiment du mal à déterminer d'où vient le problème.

Excellente journée

Hello a tous,

j'ai un peu la même demande a formuler et j'espère pouvoir trouver de l'aide sur ce forum. J'ai essayé par moi même de trouver une solution mais j'avoue être complètement largué!!

Si quelqu'un peu m'aider je lui en serais très reconnaissant. Je vais essayer d'expliquer au mieux ma demande. Merci d' avance.

Dans le fichier joint, il y a 6 onglets. Intervention cards, WO, NC, Defect characterisation, FOD inspections and CPB. Des nouvelles lignes sont renseignées tous les jours par différentes personnes. Je souhaiterai pouvoir importer ces informations dans un fichiers mère que j'ai nommé "master file" dans ce dossier Excel.

Je souhaiterai les importer automatiquement si possible ou a la demande si pas possible.

Merci à tous

12tracking-nz.xlsx (160.89 Ko)

@ PRV que donne ce code chez toi ?

msgbox Application.EnableEvents 
msgbox Application.ScreenUpdating

Hello @Rag02700,

Ce code affiche "vrai" à deux reprises

Bien à toi

Hello,

Je viens de voir que tu es sur Mac.

As-tu essayé comme ceci :

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

Path = "/Users/DATAPOSITION/" 'Change as needed
FileName = Dir(Path & "/*.xls", vbNormal)
Do While Len(FileName) > 0
Set Wkb = Workbooks.Open(FileName:=Path & "/" & FileName)
For Each WS In Wkb.Worksheets
    WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hello Rag,

Oui aucune donnée n'est collée dans mon fichier qui reste vierge...

Merci pour ton aide

Et avec le debogage ça donne quoi ?

Avec le déboggage rien ne bloque, la macro tourne mais rien ne se passe, j'ai jamais vu ça...

Hello,

Dsl je ne peux pas + t'aider, je n'ai pas de mac pour tester ...

Hello Rag,

Après réflexion j'ai fait quelques modifications mais le problème demeure, je ne sais pas s'il s'agit d'un problème lié au mac, j'ai l'impression qu'il sort de la boucle prématurément en fait...

Sub CombineSheets2()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

myPath = "/Users/uysserombaux/Desktop/DataPositions" 'Change as needed
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set Wkb = Workbooks.Open(FileName:=myPath & myFile)
DoEvents
For Each WS In Wkb.Worksheets
WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
wb.Close SaveChanges:=True 'ok
DoEvents
myFile = Dir
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Ajoute "/" apres /DataPositions

C'était donc ça !!!! Merci beaucoup, vraiment !!! Les feuilles sont toutes importées avec ce code ! Le dernier détail serait de donner à ces nouvelles feuilles le nom de leur fichier source car sans ça elles ont toutes le même nom... Par exemple si le premier fichier s'appelle YY.xlsx il faudrait que le feuille s'importe sous le nom YY (et pas feuille1). Est-ce que tu aurais une idée par hasard ?

Merci pour ton temps, excellente soirée !!

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

myPath = "/Users/DataPositions/" 'Change as needed
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set Wkb = Workbooks.Open(FileName:=myPath & myFile)
DoEvents
For Each WS In Wkb.Worksheets
WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close SaveChanges:=False
DoEvents
myFile = Dir
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hello,

Essaye ceci

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

myPath = "/Users/DataPositions/" 'Change as needed
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set Wkb = Workbooks.Open(FileName:=myPath & myFile)
DoEvents
For Each WS In Wkb.Worksheets
WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).name = myFile 
Next WS
Wkb.Close SaveChanges:=False
DoEvents
myFile = Dir
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hello Rag,

Génial merci beaucoup ! En traitant les données je me confronte à un petit problème puisque sur l'une des feuilles la ligne 1 et splitée entre la ligne 1 et 2. (Habituellement chaque case a un nom du type "J2021", "K2021"... mais sur cette feuille en particulier 2021 est en ligne 1 dans une case fusionnée au dessus de toutes les lettres correspondantes à cette année, pareil pour 2022 ect). Concrètement je devrais pouvoir concatener chaque case de la ligne 2 dans laquelle il y a une lettre, avec la date correspondante (située une case au-dessus). Par exemple si en ligne 2 j'ai 3 cases complétées des lettres J,H,K sous 2021 et 2 cases N, Z sous 2022 le code devrait pouvoir "transformer" ces cases en J2021.....N2022. Pour que le code le fasse sur la bonne feuille j'ai pensé à mettre une condition qui n'active que ce code si il y a un nombre au dessus des lettres (puisque les lignes 1 des autres feuilles sont déjà sous le format LettreAnnée)...

Bonne journée à toi

Bonjour Rag,

Après réflexion je me demande si je ne me complique pas la tâche, je m'explique : après que les trois feuilles aient été importées par le code initial j'ai trois tableaux, un dans chaque feuille. Ils ont différents formats mais je devrais les consolider dans la feuille principale "Aggregated".
Est-ce qu'il y aurait un moyen de les consolider dans un seul tableau ayant 3 colonnes (Les contrats du type "LettreAnnee", La colonne Brent et la colonne Crude).
Ceci sachant que les tableaux seront toujours disposés de la même manière mais que bien sûr le nom des contrats et les valeurs (qu'il suffit d'additionner) viendront à changer. Je me permets de joindre une image de ces tableaux.

Merci beaucoup pour ton temps

capture d ecran 2020 12 03 a 13 25 48 capture d ecran 2020 12 03 a 13 25 34 capture d ecran 2020 12 03 a 13 25 42
Rechercher des sujets similaires à "fusionner tous fichiers appartenant dossier"