Option Explicit
Sub MWTabellenAusMehrerenDateienEinlesen()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Dim s As Long
Dim z As Long
Dim y As Long
Application.ScreenUpdating = False
Set oTargetSheet = ActiveWorkbook.Sheets.Add
lErgebnisZeile = 2
sPfad = "C:\Test"
sDatei = Dir(CStr(sPfad & "*.xlsx"))
Do While sDatei <> ""
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True)
For y = 1 To oSourceBook.Sheets("Sheet1").UsedRange.Columns.Count
oTargetSheet.Cells(1, y + 1).Value = oSourceBook.Sheets("Sheet1").Cells(1, y).Value
Next y
For z = 1 To oSourceBook.Sheets("Sheet1").UsedRange.Rows.Count
If Trim(CStr(oSourceBook.Sheets("Sheet1").Cells(z, 1).Value)) <> "" Then
For s = 1 To oSourceBook.Sheets("Sheet1").UsedRange.Columns.Count
oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = oSourceBook.Sheets("Sheet1").Cells(z + 1, s).Value
Next s
lErgebnisZeile = lErgebnisZeile + 1
End If
Next z
oSourceBook.Close False
sDatei = Dir()
Loop
Application.ScreenUpdating = True
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub