Excel VBA Datein auslesen

Sub CopyCells()
    Dim strPath As String, ws As Worksheet, cFile As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'Pfad in dem die Dateien liegen (Default ist hier der Pfad in dem diese Datei liegt)  
    strPath = ThisWorkbook.Path
    'Alle *.xlsx Dateien suchen  
    cFile = Dir(strPath & "\*.xlsx")  
    With ActiveSheet
        'Jede *.xlsx Datei im aktuellen Verzeichnis öffnen  
        Do While cFile <> ""  
            'Datei öffnen und erstes Sheet referenzieren  
            Set ws = GetObject(strPath & "\" & cFile).Sheets(1)  
            With .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)  
                .Resize(1,2).Value = Worksheetfunction.Transpose(ws.Range("K1:K2"))  
                .Offset(0,2).Value = cFile
            End with
            'Datei wieder schließen  
            ws.Parent.Close False
            'nächste Datei holen  
            cFile = Dir
        Loop
        'Spaltenbreiten der Liste anpassen  
        .Range("A:B").EntireColumn.AutoFit  
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    ' Fertig  
    MsgBox "Alle Dateien wurden eingelesen", vbInformation  
End Sub