Startseite Inhaltsverzeichnis Nutzungsbedingungen Datenschutz Impressum Weitere Informationen

CODE-SCHNIPSEL

Tabellen aus mehreren Dateien einsammeln / zusammenführen

VBA und Makros • Codeschnipsel • Arbeitsblatt • Konsolidierung • Sammeln • Einsammeln

Ausgangslage ... Was tut der Codeschnipsel?

Ein immer wieder beliebtes Thema und eine andere Variante: Zusammenführen von Tabellen aus mehreren anderen Arbeitsmappen / Dateien in ein neues Tabellenblatt. Hierzu habe ich ein kleines Beispiel geschrieben. Einfach entsprechend anpassen und schon haben Sie eine Automatisierung Ihres Sammelvorganges realisiert.
Es werden alle Zeilen / Spalten des genutzten Bereiches der Tabellen ohne evtl. vorhandener Leerzeilen übernommen. Die Spalte 1 muss entsprechend gefüllt sein, da diese als Erkennungsmerkmal einer gefüllten Zeile dient (Sie können die Spalte aber im Quelltext ändern!).

VBAVBA Codeschnipsel
XLSQuelltext zur Verwendung mit Microsoft® Excel®

Der Quelltext ...

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


Public Sub OVBAde_TabellenAusMehrerenDateienEinlesen()
  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
  
    Application.ScreenUpdating = False 'Das "Flackern" ausstellen
    
    'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
    Set oTargetSheet = ActiveWorkbook.Sheets.Add
    lErgebnisZeile = 1 'Ergebnisse eintragen ab Zeile 1
    
    '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 aller genutzten Zeilen und Spalten
        For z = 1 To oSourceBook.Sheets("Tabelle1").UsedRange.Rows.Count
            'Keine Leerzeilen verarbeiten
            If Trim(CStr(oSourceBook.Sheets("Tabelle1").Cells(z, 1).Value)) <> "" Then
                For s = 1 To oSourceBook.Sheets("Tabelle1").UsedRange.Columns.Count
                    'Spalte 1 - Dateinamen
                    oTargetSheet.Cells(lErgebnisZeile, 1).Value = sDatei
                    'Spalte 2 bis n - Tabelleninhalte des Arbeitsblattes "Tabelle1"
                    oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = _
                        oSourceBook.Sheets("Tabelle1").Cells(z, s).Value
                Next s
                lErgebnisZeile = lErgebnisZeile + 1
            End If
        Next z
        
        'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
        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

Anmerkungen und Hinweise ...

Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2013.
Es gelten die Nutzungsbedingungen von Online-VBA.de.
TOTOP
ANZEIGE