VBA - Exel Dateien (aus Unterordnern) zusammenfass

Sub Zusammenfassung()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Dim s As Long
Dim z As Long
Set oTargetSheet = ActiveWorkbook.Sheets.Add
lErgebnisZeile = 1
sPfad = "\\PFAD\"
sDatei = Dir(CStr(sPfad & "NAME*.xl*"))
Do While sDatei  ""
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True)
For z = 4 To oSourceBook.Sheets("NAME").UsedRange.Rows.Count
If Trim(CStr(oSourceBook.Sheets("NAME").Cells(z, 1).Value))  "" Then
For s = 1 To oSourceBook.Sheets("NAME").UsedRange.Columns.Count
oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = _
oSourceBook.Sheets("NAME").Cells(z, s).Value
Next s
lErgebnisZeile = lErgebnisZeile + 1
End If
Next z
oSourceBook.Close False 'nicht speichern
sDatei = Dir()
Loop
Application.ScreenUpdating = True
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub