Option Explicit
Public Sub Test()
Const FILE_PATH = "C:\Temp\"
Dim strFileName As String
Dim objSheet1 As Worksheet
Dim objSheet2 As Worksheet
Dim objWorkbook1 As Workbook
Dim objWorkbook2 As Workbook
Dim aLetzte As Long
On Error GoTo err_exit
Application.ScreenUpdating = False
strFileName = Dir$(FILE_PATH & "*.xls*")
Set objWorkbook2 = ThisWorkbook
Set objSheet2 = objWorkbook2.Worksheets("Tabelle1")
aLetzte = objSheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Do While strFileName <> ""
Set objWorkbook1 = Workbooks.Open(Filename:= _
FILE_PATH & strFileName, UpdateLinks:=0)
Set objSheet1 = objWorkbook1.Worksheets("Tabelle1")
objSheet2.Cells(aLetzte, 1).Value = objSheet1.Range("B4").Text
objSheet2.Cells(aLetzte, 2).Value = objSheet1.Range("B12").Text
objSheet2.Cells(aLetzte, 3).Value = objSheet1.Range("B13").Text
objSheet2.Cells(aLetzte, 4).Value = objSheet1.Range("B14").Text
objSheet2.Cells(aLetzte, 5).Value = objSheet1.Range("B15").Text
aLetzte = aLetzte + 1
objWorkbook1.Close SaveChanges:=False
strFileName = Dir$()
Loop
err_exit:
Set objWorkbook1 = Nothing
Set objWorkbook2 = Nothing
Set objSheet1 = Nothing
Set objSheet1 = Nothing
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub