Problem beim einlesen von XLSM Dateien

Sub Test
  Dim strPath As String, ws As Worksheet, cFile As String


    Application.DisplayAlerts = False

    Application.ScreenUpdating = False


    strPath = "C:\Users\Datei\Desktop\Test\"  

    cFile = Dir(strPath & "\*.xlsm")  

    With ActiveSheet

        Do While cFile <> ""  

            Set ws = GetObject(strPath & "\" & cFile).Sheets(1)  

            With .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  
                
                .Resize(1, 1).Value = WorksheetFunction.Transpose(ws.Range("L2"))  
              
                
            End With
            
             With .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)  

            .Resize(1, 1).Value = WorksheetFunction.Transpose(ws.Range("P2"))  
               
            End With
            
             With .Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)  

            .Resize(1, 1).Value = WorksheetFunction.Transpose(ws.Range("E3"))  
                
             End With

            ws.Parent.Close False

            cFile = Dir

        Loop

        .Range("A:IT").EntireColumn.AutoFit  

    End With

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True


    MsgBox "Dateien wurden eingelesen", vbInformation  

End Sub