/ / Fusionner plusieurs fichiers .xls en une seule feuille - excel, vba, excel-vba, merge

Fusionner plusieurs fichiers .xls en une seule feuille - Excel, VBA, Excel-VBA, Merge

J'ai un dossier plein de.fichiers xls, tous les fichiers ont la même structure (noms de colonnes), je voulais que le code ouvre chaque fichier dans le dossier et copie le contenu de sheet1 et colle dans un autre fichier excel dans sheet1, ouvre le deuxième fichier copie et ajoute dans feuille 1.

Actuellement, le code que j'ai fait cela sous forme de feuille différente

  Sub GetSheets()
Path = "C:UsersdtDesktopdt kte"
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

Réponses:

1 pour la réponse № 1

Cela devrait faire l'affaire :

Sub GetSheets()
Dim WriteRow As Long, _
LastCell As Range, _
WbDest As Workbook, _
WbSrc As Workbook, _
WsDest As Worksheet, _
WsSrc As Worksheet

Set WbDest = ThisWorkbook
Set WsDest = WbDest.Sheets.Add
WsDest.Cells(1, 1) = "Set your headers here"

Path = "C:UsersdtDesktopdt kte"
Filename = Dir(Path & "*.xls")

Do While Filename <> ""
Set WbSrc = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
Set WsSrc = WbSrc.Sheets(1)
With WsSrc
Set LastCell = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
.Range(.Range("A1"), LastCell).Copy
End With
With WsDest
WriteRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row + 1
.Range("A" & WriteRow).Paste
End With

WbSrc.Close
Filename = Dir()
Loop

End Sub