CODE-SCHNIPSEL

Option Explicit
' ****************************************************************
' Autor/en und Original-Quelltext unter:
' https://www.online-vba.de/vba_datensammeln6.php
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von https://www.online-vba.de
' ****************************************************************

Public Sub OVBAde_TabellenAusMehrerenOffenenDateienEinlesen()
  Dim oTargetSheet As Object
  Dim oSoureWorkbook As Object
  Dim oTargetWorkbook As Object
  Dim lErgebnisZeile As Long
  Dim s As Long
  Dim z As Long
    
    Application.ScreenUpdating = False 'Das "Flackern" ausstellen
    
    'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
    Set oTargetWorkbook = ActiveWorkbook
    Set oTargetSheet = ActiveWorkbook.Sheets.Add
    lErgebnisZeile = 1 'Ergebnisse eintragen ab Zeile 1
    
    'Schritt 2: Schleife über alle offenen Arbeitsmappen und Datenübertragung
    For Each oSoureWorkbook In Application.Workbooks
    
        If oTargetWorkbook.Name <> oSoureWorkbook.Name Then
        
            'Datenübertragung aller genutzten Zeilen und Spalten
            For z = 1 To oSoureWorkbook.Sheets("Tabelle1").UsedRange.Rows.Count
                'Keine Leerzeilen verarbeiten
                If Trim(CStr(oSoureWorkbook.Sheets("Tabelle1").Cells(z, 1).Value)) <> "" Then
                    For s = 1 To oSoureWorkbook.Sheets("Tabelle1").UsedRange.Columns.Count
                        'Spalte 1 - Dateinamen
                        oTargetSheet.Cells(lErgebnisZeile, 1).Value = oSoureWorkbook.Name
                        'Spalte 2 bis n - Tabelleninhalte des Arbeitsblattes "Tabelle1"
                        oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = _
                            oSoureWorkbook.Sheets("Tabelle1").Cells(z, s).Value
                    Next s
                    lErgebnisZeile = lErgebnisZeile + 1
                End If
            Next z
            
        End If
        
    Next oSoureWorkbook
    
    Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
    
    'Variablen aufräumen
    Set oTargetSheet = Nothing
    Set oSoureWorkbook = Nothing
    Set oTargetWorkbook = Nothing
End Sub