Hey,

Ich versuche mich momentan an einem Excel-VBA Makro ,dass aus mehreren Excel-Dateien in verschiedenen Ordnern aus einem bestimmten Worksheet alle Tabellen in einer Tabelle zusammeführt. Dabei soll in der ersten Spalte der Ordnername stehen, in dem sich die Datei befindet.

Die Ordnerstruktur sieht so aus:

C:\Test\Ordner1\ExcelDat1

C:\Test\Ordner2ExcelDat2

C:\Test\Ordner3ExcelDat3

C:\Test\Skript

Ich hab es schon soweit hinbekommen, dass das ganze funktioniert solange alle Dateien in einem Ordner liegen und noch ohne den Namen in der ersten Spalte:

Option Explicit
'Dateien müssen alle in einem Verzeichniss liegen und unterschiedliche Namen haben.

Sub MWTabellenAusMehrerenDateienEinlesen()
   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
   Dim y As Long
  
     Application.ScreenUpdating = False 'Das "Flackern" ausstellen
    
     'Neues Arbeitsblatt für Ergbenisse
     Set oTargetSheet = ActiveWorkbook.Sheets.Add
     lErgebnisZeile = 2 'Ergebnisse eintragen ab Zeile 2
     
    
    'Hier Pfad konfigurieren
     sPfad = "C:\Test"
     sDatei = Dir(CStr(sPfad & "*.xlsx")) 'Alle .xlsx Dateien
    
    'Schleife um xlsx Dateien
     Do While sDatei <> ""
    
         'Datei öffnen
         Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'lesend öffnen
         
        'Kopfzeile einfügen
                For y = 1 To oSourceBook.Sheets("Sheet1").UsedRange.Columns.Count
                    oTargetSheet.Cells(1, y + 1).Value = oSourceBook.Sheets("Sheet1").Cells(1, y).Value
                Next y
        
         'Datenübertragung alle genutzten Zeilen und Spalten
         For z = 1 To oSourceBook.Sheets("Sheet1").UsedRange.Rows.Count
             'Leerzeilen werden ignoriert
             If Trim(CStr(oSourceBook.Sheets("Sheet1").Cells(z, 1).Value)) <> "" Then
                 For s = 1 To oSourceBook.Sheets("Sheet1").UsedRange.Columns.Count
                     'Spalte 2 bis n - Tabelleninhalte des Arbeitsblattes "Sheet1"
                     oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = oSourceBook.Sheets("Sheet1").Cells(z + 1, s).Value
                 Next s
                 lErgebnisZeile = lErgebnisZeile + 1
             End If
         Next z
        
         'Datei schließen
         oSourceBook.Close False 'nicht speichern
        
         'Nächste Datei
         sDatei = Dir()
     Loop
    
     Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
    
     'Variablen aufräumen
     Set oTargetSheet = Nothing
     Set oSourceBook = Nothing
     
End Sub

Jetzt komme ich wie gesagt mit den Ordnernnamen nicht weiter und wie ich die Excel-Dateien aus den einzelnen Unterordnern aufrufen soll.