Option Explicit
Sub Dateien_Zusammen()
Dim fso As Object
Dim baum As Object
Dim zweige As Object
Dim unterordner As Object
Dim ziel As Object
Dim pfad As String
Dim temp As String
Dim quelle As Object
Dim i As Long
Dim zeileziel As Long
Dim zeilequelle As Long
pfad = "C:\Users\Desktop\test"
Set ziel = ThisWorkbook
zeileziel = ziel.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If zeileziel < 3 Then
zeileziel = 3
Else
zeileziel = zeileziel + 1
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set baum = fso.GetFolder(pfad)
Set zweige = baum.subfolders
For Each unterordner In zweige
temp = unterordner.Path & "\" & "GKW.xls"
If fso.fileexists(temp) Then
Workbooks.Open (temp)
Set quelle = ActiveWorkbook
For i = 1 To quelle.Worksheets.Count
zeilequelle = quelle.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
If zeilequelle > 2 Then
quelle.Worksheets(i).Range("B3:F" & zeilequelle).Copy ziel.Worksheets(1).Cells(zeileziel, 2)
zeileziel = zeileziel + zeilequelle - 1
End If
Next i
quelle.Close
End If
Next unterordner
End Sub