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)
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
VBA Programmierer gesucht?
http://www.WershovenOnline.de
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...
