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.
Ergebnisse statt Aufwand & Arbeit?
Wir liefern Ergebnisse - Schicken Sie uns kurz Ihre Datei und Ihre Wünsche; wir integrieren den notwendigen Code professionell, beheben ggf. vorhandene Fehler, machen optional ein Code-Review, liefern bei Bedarf Performance-Optimierungen & setzen gewünschte Erweiterungen effizient für Sie um (und das zum Festpreis nach kurzer Sichtung).
Express-Service beauftragen
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
Das könnte Sie auch interessieren:
Wir unterstützen Sie mit einem VBA-Entwickler für Hamburg – Festpreise und direkter Ansprechpartner. Entdecken Sie unser gesamtes Portfolio auf der Startseite der Lösungsarchitekten – kompakt und transparent.
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.
