Startseite Inhaltsverzeichnis Nutzungsbedingungen Datenschutz Impressum Weitere Informationen

CODE-SCHNIPSEL

Werte aus mehreren Sheets einer Datei in eine neue Tabelle zusammenführen

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

Ausgangslage ... Was tut der Codeschnipsel?

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.

VBAVBA Codeschnipsel
XLSQuelltext zur Verwendung mit Microsoft® Excel®

Der Quelltext ...

Option Explicit
' ****************************************************************
' Autor/en und Original-Quelltext unter:
' https://www.online-vba.de/vba_datensammeln2.php
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von https://www.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.
Es gelten die Nutzungsbedingungen von Online-VBA.de.
TOTOP
ANZEIGE