Copie classeurs dans un seul

Bonjour à tous,

J'ai plusieurs fichiers EXCEL que j'aimerais fusionner dans un seul fichier au moyen de la macro suivante. Cependant, je souhaiterais également que les onglets du fichier FUSION prennent le nom de leur Fichier respectif et pas de l'onglet. En effet s'agissant d'import, les onglets des fichiers initiaux ont des noms à dormir dehors

Comment dois-je modifier la macro suivante ?

Sub GetSheets()

Path = "C:\Users\im\Documents\1 - LM\"

Filename = Dir(Path & "*.xls")

Do While Filename <> ""

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

For Each Sheet In ActiveWorkbook.Sheets

Sheet.Copy After:=ThisWorkbook.Sheets(1)

Next Sheet

Workbooks(Filename).Close

Filename = Dir()

Loop

End Sub

J'ajoute à toutes fins utiles que le but ultime du tableau est que les données de l'ensemble des Fichiers initiaux s'agrègent sur 1 seul onglet en évitant les doublons de ligne grâce à un numéro de référence présent dans chaque fichier et en évitant les doublons de colonne grâce à l’intitulé des colonnes de chaque fichier. En somme il y'aura forcément des doublons, mais pour cette seconde étape, je pense agir étape par étape.

Je vous remercie par avance de votre aide !

Bonjour,

à tester,

Sheet.Copy After:=ThisWorkbook.Sheets(Sheets.Count)
ThisWorkbook.Sheets(Sheets.Count).Name = Filename

Salut I20100,

Le bout de code que tu m'as donné semble fonctionner. Je l'ai inséré comme ci-dessous.

Sub GetSheets()

End Sub

Par contre EXCEL m'indique qu'il y a un bug. Je pense que c'est au niveau de la boucle, car avec ce code seul l'onglet 1 est copié.

Aurais-tu une idée d'où peut venir l'erreur ?

Merci par avance !

re,

à tester

Sheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Filename

aussi vérifier si le nom Filename ne contient pas de caractère interdis pour le nom d'onglet...

Sub Nomme_Feuille()
n = 1
ncar = Len(Cells(1, 1))
NomNew = Epure(Cells(1, 1))
ActiveSheet.Name = NomNew & " " & n
End Sub

Function Epure$(txt$)
txt = Left(Trim(txt), 28)
txt = Replace(Replace(txt, "/", "#"), "\", "#")
txt = Replace(Replace(txt, "*", "#"), "?", "#")
Epure = Replace(Replace(txt, "[", "#"), "]", "#")
End Function

Oui j'avais regardé au niveau des caractères et de la longueur (comme le suggère le débogueur), mais rien à ce niveau. J'ai écrit le code suivant, je n'identifie pas d'erreur de rédaction. Est-ce que quelqu'un en voit une ?

Sub GetSheets()

End Sub

re,

il faudrait modifier cette ligne

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Filename

par

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Filename & ThisWorkbook.Sheets.Count

pour éviter que 2 feuilles aient le même nom.