Werte aus Sheets sammeln
Ausgangslage - Was tut dieser Code-Schnipsel?
Zusammenführen von Werten aus mehreren Arbeitsblättern der geöffneten Arbeitsmappe / Datei zu einer großen Tabelle. Hierzu habe ich ein kleines Beispiel geschrieben. Einfach entsprechend anpassen und schon haben Sie eine Automatisierung Ihres Sammelvorganges realisiert.
Der Quelltext
Option Explicit
' Original-Quelltext unter: https://www.online-vba.de/werte-aus-sheets-sammeln
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de
Public Sub OVBAde_DatenAusMehrerenSheets()
Dim oTargetSheet As Object
Dim oSheet As Object
Dim lErgebnisZeile As Long
Dim i 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 Sheets
For Each oSheet In ActiveWorkbook.Sheets
'Schritt 3: Datenübertragung nur, wenn nicht das neue Blatt vorliegt
If oSheet.Name <> oTargetSheet.Name Then
'Blattnamen in Spalte 1 eintragen
oTargetSheet.Cells(lErgebnisZeile, 1).Value = CStr(oSheet.Name)
'Eigentliche Datenübertragung - Als Beispiel die Zellen A1 bis A10
For i = 1 To 10
oTargetSheet.Cells(lErgebnisZeile, i + 1).Value = _
oSheet.Cells(1, i).Value
Next i
'Schritt 4: Nächste Zeile in der Ergebnistabelle und nächstes Arbeitsblatt
lErgebnisZeile = lErgebnisZeile + 1 'nächste Zeile auf dem Ergebnisblatt
End If
Next oSheet
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSheet = Nothing
End Sub
Anmerkungen und Hinweise
Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2013.
Die Nutzung erfolgt auf eigene Gefahr.
Bitte denken Sie immer zuerst an eine ausreichende Datensicherung.
Wir können keinen kostenlosen Support anbieten.
Es gelten unsere Nutzungsbedingungen.
