VBA

Sub BlaetterZusammenkopieren()
Dim objTargetWorksheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisSpalte As Long
Dim s As Long
Dim z As Long
Set objTargetWorksheet = ActiveSheet
'Application.ScreenUpdating = False
Set objTargetWorksheet = ActiveSheet
lErgebnisSpalte = 1
sPfad = "D:\Users\BKU\sebastianlenglein\Desktop\Test Excel\Neuer Ordner\test\"
sDatei = Dir(CStr(sPfad & "*.xlsb"))
Do While sDatei  ""
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True)
For s = 1 To oSourceBook.Sheets(1).UsedRange.Columns.Count
For z = 1 To oSourceBook.Sheets(1).UsedRange.Rows.Count
objTargetWorksheet.Cells(z, lErgebnisSpalte).Value = _
oSourceBook.Sheets(1).Cells(z, s).Value
Next z
lErgebnisSpalte = lErgebnisSpalte + 1
Next s
oSourceBook.Close False
sDatei = Dir()
Loop
'Application.ScreenUpdating = True
Set objTargetWorksheet = Nothing
Set oSourceBook = Nothing
End 

Sub