Dateien zusammenziehen

Sub Zusammenführen()
Dim wksTarget As Worksheet
Dim arr As Variant
Dim iCounter As Integer, iRows As Integer, iRowT As Integer
Dim sPath As String, sPattern As String
Application.ScreenUpdating = False
Workbooks.Add
Set wksTarget = Worksheets(1)
Range("A1") = "Datenimport"
Range("A1").Font.Bold = True
sPath = ThisWorkbook.Path
sPattern = "Test*.xls"
arr = arrAll(sPath, sPattern)
For iCounter = 1 To UBound(arr)
Workbooks.Open arr(iCounter)
iRows = Cells(Rows.Count, 3).End(x1Up).Row
iRowT = wksTarget.Cells(Rows.Count, 1).End(x1Up).Row + 2
With wks.Target.Cells(iRowT, 1)
.Value = arr(iCounter) & ":"
.Font.Bold = True
End With
iRowT = iRowT + 2
Rows("2:" & iRows).Copy wksTarget.Cells(iRowT, 1)
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
Next iCounter
Columns.AutoFit
End Sub

Function arrAll(sPath As String, sPattern As String) As Variant
Dim arr()
Dim iCounter As Integer
Dim sFile As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & sPattern)
Do While sFile <> ""
iCounter = iCounter + 1
ReDim Preserve arr(1 To iCounter)
arr(iCounter) = sFile
sFile = Dir()
Loop
arrAll = arr
End Function