Inhalte auslesen

Sub Einlesen1()
Dim iCounter As Integer, iRow As Integer
Dim sfile As String, sPath As String
iRow = Cells(Rows.Count, 1).End(xlUp).Row + 2
With Application.FileSearch
.LookIn = Range("g1").Value
.FileType = msoFileTypeExcelWorkbooks
.Execute
For iCounter = 1 To .FoundFiles.Count
sfile = Dir(.FoundFiles(iCounter))
sPath = WorksheetFunction.Substitute(.FoundFiles(iCounter), sfile, "")
With Cells(iRow, 1)
.Formula = "='" & sPath & "[" & sfile & "]Auftragsblatt'!c26"
.Value = .Value
End With
iRow = iRow + 1
Next iCounter
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub Einlesen2()
Dim i As Integer, b As Integer
Dim c As String, a As String
i = 0
b = 0
c = 0
a = 0
b = Cells(Rows.Count, 1).End(xlUp).Row
With Application.FileSearch
.LookIn = Range("g1").Value
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
c = Dir(.FoundFiles(i))
a = WorksheetFunction.Substitute(.FoundFiles(i), c, "")
With Cells(b, 3)
.Formula = "='" & a & "[" & c & "]Auftragsblatt'!c52"
.Value = .Value
End With
b = b + 1
Next i
End With
End Sub

Sub suchen()
Call Einlesen1
Call Einlesen2
End Sub