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