versuchs mal damit, sheetnamen mußt du noch anpassen
Sub Makro2()
Dim objSheet As Object
Dim shZ As Worksheet
Dim iRow As Long, j As Long
Dim strDateipfad As String
Dim strPfad As String
Dim strDateiname As String
Dim Wb As Workbook, WbZ As Workbook
Set WbZ = ThisWorkbook
Set shZ = WbZ.Worksheets(1)
strPfad = ThisWorkbook.Path & Application.PathSeparator
For iRow = 4 To shZ.Cells(WbZ.Rows.Count, 4).End(xlUp).Row
If shZ.Cells(iRow, 2) <> "" Then
Exit Sub
Else
strDateiname = shZ.Cells(iRow, 2)
strDateipfad = strPfad & strDateiname & ".xlsm"
If Dir(strDateipfad) = "" Then
Else
Set Wb = Workbooks.Open(strDateipfad, ReadOnly:=True)
Set objSheet = Wb.Sheets(1)
For j = 7 To 27
shZ.Cells(iRow, j) = objSheet.Cells(j + 19, 2)
Next j
Wb.Close
set Wb = nothing : set objSheet = nothing
End If
End If
Next iRow
set WbZ = Nothing : Set shZ = nothing
End Sub