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
Application.ScreenUpdating = False
Set oTargetSheet = ActiveWorkbook.Sheets.Add
lErgebnisZeile = 1
sPfad = "C:\Users\Schweikardt\Documents\Test\"
sDatei = Dir(CStr(sPfad & "*.xl*"))
Do While sDatei <> ""
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True)
For z = 1 To oSourceBook.Sheets(1).UsedRange.Rows.Count
If Trim(CStr(oSourceBook.Sheets(1).Cells(z, 1).Value)) <> "" Then
For s = 1 To oSourceBook.Sheets(1).UsedRange.Columns.Count
oTargetSheet.Cells(lErgebnisZeile, 1).Value = sDatei
oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = _
oSourceBook.Sheets(1).Cells(z, 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