Anzeige

VBA
Programmierer
gesucht?
 
Anzeige
VBA Programmierer gesucht?
 

VBA Codeschnipselsammlung

Tabellen aus mehreren offenen Dateien einsammeln / zusammenführen

Ein immer wieder beliebtes Thema und eine andere Variante, diesmal aus geöffneten Dateien: 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 Sammelvorgangs realisiert. Es werden alle Zeilen / Spalten des genutzten Bereiches der Tabellen ohne evtl. vorhandener Leerzeilen übernommen. Daher muss die Spalte 1 gefüllt sein, da diese als Erkennungsmerkmal einer gefüllten Zeile dient (Sie können die Spalte aber im Quelltext ändern!).

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_datensammeln6.php
' ************************************************************************************************


Sub MWTabellenAusMehrerenOffenenDateienEinlesen()
   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 alle 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


Autor: Marc Wershoven (2014)

Anzeige

WershovenOnline® DatenSammlerTool Version 2

Universelles Sammelwerkzeug zur Verwendung mit Microsoft® Excel®

Für alle Nicht-Programmierer gibt es selbstverständlich auch ein komplett fertiges Tool, welches Sie - ohne programmieren zu können - flexibel auf Ihre Bedürfnisse adaptieren können. Probieren Sie es doch einfach aus!

Zum WershovenOnline® DatenSammlerTool

Anzeige

VBA Programmierer gesucht?
http://www.WershovenOnline.de

Anzeige

Der Quick E-Mail Support von WershovenOnline®

Schnelle Hilfe bei Fragen rund um Microsoft® Office und VBA Makros

Der Quick E-Mail Support von WershovenOnline® Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach! Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!

Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.

Zum Anbieter des Quick-E-Mail-Support...

Zum Seitenanfang