Excel VBA – Jede Zeile in eine bestimmte Tabelle kopieren
Dieser Beitrag ist ein Teil der VBA Grundlagen Serie.
Oft möchte man die Werte einer Tabelle automatisch auf mehrere Tabellenblätter verteilen. In diesem Artikel zeige ich Ihnen, wie Sie alle Zeilen einer Tabelle variabel in ein separates Arbeitsblatt kopieren können. Am besten lässt es sich anhand eines Beispiels erklären. [PostTopVBA]
In diesem Fall liegt uns die folgende Tabelle vor.
Stadt | Jahr | Einwohner |
Köln | 2013 | 1.020.000 |
München | 2013 | 1.388.000 |
Berlin | 2013 | 3.502.000 |
Düsseldorf | 2013 | 593.682 |
Gelnhausen | 2013 | 21.489 |
Köln | 2020 | 1.326.000 |
München | 2020 | 1.804.400 |
Berlin | 2020 | 4.552.600 |
Düsseldorf | 2020 | 771.787 |
Gelnhausen | 2020 | 27.936 |
Für die jeweilige Stadt sind das Jahr und die Einwohner aufgeführt. Nun wollen wir die Werte für eine Stadt in ein eigenes Arbeitsblatt kopieren. Falls kein Arbeitsblatt mit dem Städtenamen existiert, soll in das Arbeitsblatt „Sonstige“ kopiert werden.
Außer Gelnhausen gibt es für jede Stadt ein eigenes Arbeitsblatt. Zwecks besserer Übersicht habe ich die Tabellennamen in den VBA Eigenschaften (Tastenkombination ALT+F11
) geändert.
In unserem Beispiel ist es wichtig zu prüfen, ob ein bestimmtes Arbeitsblatt existiert. Daher wechseln wir mit der Tastenkombination ALT+F11 in die Entwicklungsumgebung und fügen ein neues Modul ein. Anschließend erstellen wir die folgende Funktion.
Function TabEx(strTab As String) As Boolean
Dim Blatt As Worksheet
TabEx = False
For Each Blatt In ActiveWorkbook.Worksheets
If Blatt.Name = strTab Then
TabEx = True
Exit Function
End If
Next Blatt
End Function
Eine detaillierte Erklärung finden Sie im Beitrag Excel VBA – Tabellenexistenz prüfen meiner VBA Grundlagen Serie.
[PostMiddleVBA]
Nun geht es an die eigentliche Arbeit. Zunächst deklarieren wir alle benötigen Elemente. Dann legen wir die Tabelle fest, die als Ausgangsbasis dient (Quelle). Als nächstes wird die Anzahl der benutzten Zeilen berechnet. Diese Zeilen arbeiten wir dann nacheinander ab.
Dieses Gerüst sieht in VBA wie folgt aus:
Sub KopieStadt()
Dim Zeile As Long
Dim ZeileMax As Long
Dim ZeileZiel As Long
Dim i As Long
Dim n As Integer
With Quelle
ZeileMax = .UsedRange.Rows.Count
For Zeile = 2 To ZeileMax
Next Zeile
End With
End Sub
Nun prüfen wir für jede Zeile, ob ein Arbeitsblatt mit dem Namen der Stadt existiert. Dazu nutzen wir die zuvor angelegte Funktion TabEx. Die Stadt steht in der ersten Spalte der jeweiligen Spalte.
If TabEx(.Cells(Zeile, 1).Value) = True Then
'Tabelle existiert
Else
'Tabelle existiert nicht
End If
Wenn es ein Arbeitsblatt mit dem Namen der Stadt gibt, wird die Zeile dorthin kopiert. Dabei wird immer in die nächste leere Zeile kopiert. So werden die vorherigen Werte nicht überschrieben.
Falls die Stadt kein eigenes Arbeitsblatt hat, wird die Zeile nach „Sonstige“ kopiert.
In VBA sieht diese Logik so aus:
If TabEx(.Cells(Zeile, 1).Value) = True Then
'Tabelle existiert
ZeileZiel = Sheets(.Cells(Zeile, 1).Value).UsedRange.Rows.Count
ZeileZiel = ZeileZiel + 1
.Rows(Zeile).Copy Destination:=Sheets(.Cells(Zeile, 1).Value).Rows(ZeileZiel)
Else
'Tabelle existiert nicht
ZeileZiel = Sonstige.UsedRange.Rows.Count
ZeileZiel = ZeileZiel + 1
.Rows(Zeile).Copy Destination:=Sonstige.Rows(ZeileZiel)
End If
Anbei der vollständige Code. [VbaMakrosBuch]
Option Explicit
Sub KopieStadt()
Dim Zeile As Long
Dim ZeileMax As Long
Dim ZeileZiel As Long
Dim i As Long
Dim n As Integer
With Quelle
ZeileMax = .UsedRange.Rows.Count
For Zeile = 2 To ZeileMax
If TabEx(.Cells(Zeile, 1).Value) = True Then
'Tabelle existiert
ZeileZiel = Sheets(.Cells(Zeile, 1).Value).UsedRange.Rows.Count
ZeileZiel = ZeileZiel + 1
.Rows(Zeile).Copy Destination:=Sheets(.Cells(Zeile, 1).Value).Rows(ZeileZiel)
Else
'Tabelle existiert nicht
ZeileZiel = Sonstige.UsedRange.Rows.Count
ZeileZiel = ZeileZiel + 1
.Rows(Zeile).Copy Destination:=Sonstige.Rows(ZeileZiel)
End If
Next Zeile
End With
End Sub
Function TabEx(strTab As String) As Boolean
Dim Blatt As Worksheet
TabEx = False
For Each Blatt In ActiveWorkbook.Worksheets
If Blatt.Name = strTab Then
TabEx = True
Exit Function
End If
Next Blatt
End Function
[PostBottomVBA]
Quellen und weiterführende Literatur:
Bernd Held – VBA mit Excel: Das umfassende Handbuch
Falls Ihnen dieser Beitrag weitergeholfen hat, wäre es eine sehr nette Anerkennung meiner Arbeit wenn Sie z.B. Ihre Bücher über Amazon bestellen würden. Wenn Sie ein Produkt kaufen, erhalte ich dafür eine Provision. Für Sie ändert sich am Preis des Produktes gar nichts. Ich möchte mich an dieser Stelle jetzt schon für Ihre Unterstützung bedanken.
Hallo, ich verzweifle ich hab ja die userform erstellt alles funktioniert ausser das ich noch zwei dropdown Elemente füllen muss mit Werten. Das wollte ich gerade tun aber im vba Editor ist der Code sowie auch die uf weg wie kann ich diese wieder finden bzw öffnen?
Wurde es vielleicht zwischengespeichert? Wenn du die Excel Datei schließt und wieder aufmachst?