Werte aus Dateien sammeln

Option Explicit
' Original-Quelltext unter: https://www.online-vba.de/werte-aus-dateien-sammeln
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de

Public Sub OVBAde_DatenAusMehrerenDateienEinlesen()
  Dim oTargetSheet As Object
  Dim oSourceBook As Object
  Dim sPfad As String
  Dim sDatei As String
  Dim lErgebnisZeile As Long
    
    Application.ScreenUpdating = False 'Das "Flackern" ausstellen

    'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
    Set oTargetSheet = ActiveWorkbook.Sheets.Add
    lErgebnisZeile = 2 'Ergebnisse eintragen ab Zeile 2
    
    'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
    sPfad = "C:\TEST\Sammlung\"
    sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
    
    Do While sDatei <> ""
    
        'Schritt 3: öffnen der Datei und Datenübertragung
        Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
        
        'Datenübertragung
        'Spalte 1 - Dateinamen
        oTargetSheet.Cells(lErgebnisZeile, 1).Value = sDatei
        'Spalte 2 - Zelleninhalt A1 vom Arbeitsblatt "Tabelle1"
        oTargetSheet.Cells(lErgebnisZeile, 2).Value = _
            oSourceBook.Sheets("Tabelle1").Cells(1, 1).Value
        
        'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
        oSourceBook.Close False 'nicht speichern
        
        'Nächste Datei
        sDatei = Dir()
        lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
        
    Loop
    
    Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
    
    'Variablen aufräumen
    Set oTargetSheet = Nothing
    Set oSourceBook = Nothing
End Sub