Sub Lesen()
Dim Pfad As String, Datei As String
Dim WB As Workbook, TB As Workbook
Dim WS As Worksheet, TS As Worksheet
Dim i As Long
Set TB = ThisWorkbook
Set TS = TB.Worksheets("Dein_Tabellen_Name")
Pfad1 = "c:\"
Datei = Dir(Pfad1 & "*.xls*")
i = 3
Do While Datei <> ""
If Datei <> "." And Datei <> ".." Then
Set WB = Workbooks.Opem(Pfad & Datei)
Set WS = WB.Worksheets("TEST")
With WS
TS.Cells(i, 1).Value = .Range("A2").Value
TS.Cells(i, 2).Value = .Range("E4").Value
i = i + 1
End With
WB.Close False
End If
Datei = Dir()
Loop
End Sub