Sub einlesen()
Dim fso As Object
Dim pfad As String
Dim start As Object
Dim neu As Object
Dim ende As Long
Dim ordner As Object
Dim datei As Object
Set start = ThisWorkbook.Worksheets(2)
Set fso = CreateObject("Scripting.Filesystemobject")
pfad = "C:\Bestellungen\Uebersicht\Kunden"
ende = start.Cells(start.Rows.Count, 1).End(xlUp).Row + 1
Set ordner = fso.getfolder(pfad)
For Each datei In ordner.Files
If Right(datei.Name, 4) = ".xls" Or Right(datei.Name, 5) = ".xlsx" Or Right(datei.Name, 5) = ".xlsm" Then
Workbooks.Open pfad & "\" & datei.Name
Set neu = ActiveWorkbook
neu.Worksheets(1).Rows(3).Copy start.Cells(ende, 1)
ende = ende + 1
neu.Close
End If
Next
Set neu = Nothing
Set start = Nothing
Set fso = Nothing
End Sub