Private Sub Zusammen(Liste As Variant)
Dim v, r
Dim lstarr
r = 18
For Each v In Liste
lstarr = Werte(v)
Cells(r, 3).Resize(UBound(lstarr, 1), UBound(lstarr, 2)).Value = lstarr
r = Cells.Find("*", Cells(1), -4123, 2, 1, 2, False).Row + 1
Next v
End Sub
Private Function Werte(Pfad) As Variant
Dim wbk As Workbook
Application.ScreenUpdating = False
Set wbk = Workbooks.Open(Pfad)
Werte = wbk.Sheets(1).ListObjects(1).DataBodyRange.Value
wbk.Close False
Application.ScreenUpdating = True
End Function