VBA - Daten von Netzlaufwerk Ordner importieren

Sub zusammenfuegen()
ActiveSheet.Range(Rows(3), Rows(Rows.Count)).Delete
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strpath = "Z:\"
strDateiname = Dir(strpath & "\*.xls")
With ThisWorkbook.Worksheets("Auswertung")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Workbooks.Open Filename:=strpath & "\" & strDateiname
Sheets("Liste").Select
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.Sheets("Liste").UsedRange.SpecialCells(xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.Sheets("Liste").UsedRange.SpecialCells(xlCellTypeLastCell).Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy Destination:=. _
Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub