VBA Excel Mehrere Dateien auslesen

Sub ImportFoundRows()

    'Pfad zu den Dateien  
    Const PATH = "F:\Daten\Daten\Test"  

    'Variablen  
    Dim wb As Workbook, strSearchTerm As String, c As Range, firstAddress As String, file As String

    'Suchwort  
    strSearchTerm = "Toll"  

    'Displayaktualisierung deaktivieren  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    'Dateien suchen  
    file = Dir(PATH & "\*.xls")  

    While file <> ""  

        'Datei öffnen  
        Set wb = Workbooks.Open(PATH & "\" & file, ReadOnly:=True)  

        With wb.Sheets(1)

            'In der Spalte G nach dem Suchwort suchen  
            With .Range("G2:G" & .Cells(Rows.Count, "G").End(xlUp).Row)  

                Set c = .Find(strSearchTerm, LookIn:=xlValues, Lookat:=xlPart)

                If Not c Is Nothing Then

                    firstAddress = c.Address

                    Do

                        'Ganze gefundene Zeile in das aktuelle Sheet kopieren  
                        c.EntireRow.Copy ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  

                        Set c = .FindNext(c)

                    Loop While Not c Is Nothing And c.Address <> firstAddress

                End If

            End With

        End With

        'Datei schließen  

        wb.Close False

        'Nächste Datei suchen  

        file = Dir

    Wend

    'Displayaktualisierung wieder aktivieren  
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub