Sub
GetData()
Dim
oMe
As
Worksheet, iZeile
As
Long
, oDatei
As
Object
Dim
oFS
As
Object
, wbQuelle
As
Workbook
Set
oMe = ThisWorkbook.ActiveSheet
Const
sDateiPfad
As
String
= " \"
iZeile = 19
Application.ScreenUpdating =
False
Set
oFS = CreateObject(
"Scripting.FileSystemObject"
)
For
Each
oDatei
In
oFS.GetFolder(sDateiPfad).Files
If
InStrRev(oDatei.name,
"xlsx"
)
Then
Set
wbQuelle = Workbooks.Open(sDateiPfad & oDatei.name)
With
wbQuelle.ActiveSheet
oMe.Cells(iZeile, 2) = .Range(
"B5"
)
oMe.Cells(iZeile, 3) = .Range(
"B13"
)
wbQuelle.Close
False
iZeile = iZeile + 1
End
With
End
If
Next
Set
oMe =
Nothing
:
Set
wbQuelle =
Nothing
End
Sub