Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_datensammeln.php
' ************************************************************************************************

Sub MWDatenAusMehrerenDateienEinlesen()
   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