In einem Forum kam die Frage auf, wie man markierte Zeilen per VBA kopieren kann. Im Prinzip ist das nicht schwer und ich werde hier zeigen, wie es genau geht. Zudem stelle ich eine Beispiel-Datei mit dem Code hier zum Download zur Verfügung.
Die eigentliche Arbeit des Kopierens und Einfügens ist einfach:
shSource.Rows(lSourceRow).Copy
shTarget.Cells(lTargetRow, 1).Select
shTarget.Paste
Code-Sprache: CSS (css)In Zeile 1 wird der Inhalt einer Zeile aus dem Quell-Arbeitsblatt shSouce in den Zwischenspeicher kopiert. Zeile 2 markiert eine Zeile im Ziel-Arbeitsblatt, in die eingefügt werden soll. Zeile 3 fügt schließlich den Inhalt der Zwischenablage ein.
Die Frage ist nun, woher weiß der Code, was Quell- und Zielarbeitsblätter sind und welche Zeilen berücksichtigt werden müssen?
Welche Arbeitsblätter werden verwendet?
Nun die Info, welche Arbeitsblätter als Quelle und als Ziel dienen, müssen wir dem Code natürlich irgendwie mitgeben. Dazu definieren wir einfach zwei entsprechende Parameter in der Prozedur und füllen diese mit den Namen der jeweiligen Blätter:
Private Sub doCopyRows(ByVal pSourceSheetName As String, ByVal pTargetSheetName As String, ByVal pStatusColumn As Integer, ByVal pFirstRow As Long)
Code-Sprache: PHP (php)In pSourceSheetName erwarten wir den Namen des Quell-Blattes und in pTargetSheetName dementsprechend den Namen des Ziel-Blattes. Zusätlich brauchen wir später auch noch zwei weitere Parameter pStatusColumn und pFirstRow. Der erste legt fest, welche Spalte festlegt, ob eine Zeile kopiert werden soll oder nicht und der zweite gibt an, von welcher Zeile an gesucht werden soll … schließlich wollen wir ja eventuelle Überschriften etc. nicht mit kopieren. Wir müssen also wissen, ab welcher Zeile die eigentlichen Daten zu finden sind.
Der fertige Aufruf der Prozedur wird dann später zum Beispiel so aussehen:
Public Sub copyRows()
doCopyRows "Quelle", "Ziel", 1, 4
End Sub
Code-Sprache: PHP (php)Es wird also von einem Blatt Namens „Quelle“ in ein Blatt „Ziel“ umkopiert werden. Die erste Spalte wird analysiert und die Daten befinden sich im Quell-Blatt ab Zeile 4.
Wie kommen wir aber nun vom Blatt-Namen zum eigentlich Blatt? Dafür gehen wir einfach alle Blätter der Mappe durch bis wir den gesuchten Namen finden. Hierfür habe ich eine eigene kleine Funktion geschrieben:
Private Function getWorkSheet(ByVal pName As String) As Worksheet
Dim i As Integer
For i = 1 To Sheets.Count
If Sheets(i).Name = pName Then
Set getWorkSheet = Sheets(i)
Exit Function
End If
Next
End Function
Code-Sprache: JavaScript (javascript)Hier wird der Name übergeben und dafür erhält man das entsprechende Worksheet zurück. So könne wir jetzt aus den Namen der beiden Arbeitsblätter die jeweiligen Worksheet-Objekte ableiten:
Set shSource = getWorkSheet(pSourceSheetName)
Set shTarget = getWorkSheet(pTargetSheetName)
Code-Sprache: JavaScript (javascript)Die Sache mit den Zeilen
Woher weiß das Programm, welche Zeilen verarbeitet werden müssen? Nun schauen wir uns zunächst an, wie wir herausfinden, was die letzte verwendete Zeile im Ziel-Blatt ist, denn in der Zeile darunter müssen wir dann später einfügen.
lTargetRow = shTarget.UsedRange.Rows(shTarget.UsedRange.Rows.Count).Row
lSourceRowMax = shSource.UsedRange.Rows(shSource.UsedRange.Rows.Count).Row
Das ist auf den ersten Blick etwas verwirrend. Warum können wir nicht direkt shTarget.UsedRange.Rows.Count verwenden? Nehmen wir an, wir haben auf dem Ziel-Blatt nur die Spaltenüberschriften in Zeile 3 und sonst nichts. Dann liefert shTarget.UsedRange.Rows.Count den Wert 1, da wir ja nur eine Zeile benutzen. Zeilen 1 + 2 sind ja leer. Wir müssen deshalb „um’s Eck“ denken. Wir gehen zum UsedRange-Objekt und lassen uns von ihm die letzte Zeile innerhalb dieses Range-Objektes geben – und davon mit Row die Zeilennummer.
Das Gleiche machen wir dann auch noch mit dem Quell-Blatt, den bislang wissen wir ja nur, wo sich die erste Daten-Zeile befindet (zur Erinnerung, das sagt uns der Parameter pFirstRow). Wir müssen aber auch noch wissen, welches die letzte Zeile ist. Das speichern wir uns in einer Variable lSourceRowMax ab.
Schleife über alle Zeilen
Da wir jetzt die entsprechenden Blätter sowie Start- bzw. End-Zeile des Quell-Blattes und die letzte Zeile im Ziel-Blatt haben, können wir Zeile für Zeile der Quelle durchlaufen:
For lSourceRow = pFirstRow To lSourceRowMax
' -------------------
' check status column
' -------------------
If shSource.Cells(lSourceRow, pStatusColumn) <> "" Then
' --------------------
' increment target row
' --------------------
lTargetRow = lTargetRow + 1
' ------------------------------
' copy row from source to target
' ------------------------------
shSource.Rows(lSourceRow).Copy
shTarget.Cells(lTargetRow, 1).Select
shTarget.Paste
End If
Next
Code-Sprache: PHP (php)Das machen wir mit einer For-Next-Schleife. Diese Zählt eine Variable lSourceRow hoch. Sie beginnt dabei mit dem Wert, der im Parameter pFirstRow übergeben wurde. Als End-Kriterium haben wir ja vorhin lSourceRowMax als letzte benutzte Zeile ermittelt.
In Code-Zeile 5 wird dann die Zelle analysisiert, die darüber entscheidet, ob die Zeile kopiert werden soll oder nicht. Im Beispiel wird einfach vergleichen, ob irgendetwas in dieser Zelle steht. Hier kann man natürlich noch etwas differenzierte Kriterien einbauen wenn nötig.
Wenn dieser If-Then Vergleich Wahr liefert, dann wird zunächst lTargetRow um 1 erhöht. Wir erinnern uns: diese Variable gibt uns die letzte benutzte Zeile im Ziel-Blatt. Wir müssen aber nicht in diese, sondern in die Zeile darunter einfügen. Also erhöhen wir sie entspechend um 1.
Dann kommt wieder der bereits besprochene Copy-Paste Code und damit ist die Lösung eigentlich schon fertig.
Der ganze Code
Hier jetzt noch mal der ganze Code, wie man Zeilen per VBA kopieren kann:
Option Explicit
Public Sub copyRows()
doCopyRows "Quelle", "Ziel", 1, 4
End Sub
Private Sub doCopyRows(ByVal pSourceSheetName As String, ByVal pTargetSheetName As String, ByVal pStatusColumn As Integer, ByVal pFirstRow As Long)
On Error GoTo err_handler
' -------------------------
' define required variables
' -------------------------
Dim shSource As Worksheet
Dim shTarget As Worksheet
Dim lTargetRow As Long
Dim lSourceRowMax As Long
Dim lSourceRow As Long
' -----------------------------
' load source and target sheets
' -----------------------------
Set shSource = getWorkSheet(pSourceSheetName)
Set shTarget = getWorkSheet(pTargetSheetName)
' ------------------
' get last used rows
' ------------------
lTargetRow = shTarget.UsedRange.Rows(shTarget.UsedRange.Rows.Count).Row
lSourceRowMax = shSource.UsedRange.Rows(shSource.UsedRange.Rows.Count).Row
' ------------------------
' make target active sheet
' ------------------------
shTarget.Select
' -----------------------------
' loop thru used rows in source
' -----------------------------
For lSourceRow = pFirstRow To lSourceRowMax
' -------------------
' check status column
' -------------------
If shSource.Cells(lSourceRow, pStatusColumn) <> "" Then
' --------------------
' increment target row
' --------------------
lTargetRow = lTargetRow + 1
' ------------------------------
' copy row from source to target
' ------------------------------
shSource.Rows(lSourceRow).Copy
shTarget.Cells(lTargetRow, 1).Select
shTarget.Paste
End If
Next
shTarget.Cells(lTargetRow, 1).Select
MsgBox "Fertig"
err_exit:
On Error Resume Next
' ----------------------
' free object references
' ----------------------
Set shSource = Nothing
Set shTarget = Nothing
Application.CutCopyMode = False
Exit Sub
err_handler:
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Fehler"
Resume err_exit
Resume
End Sub
Private Function getWorkSheet(ByVal pName As String) As Worksheet
Dim i As Integer
For i = 1 To Sheets.Count
If Sheets(i).Name = pName Then
Set getWorkSheet = Sheets(i)
Exit Function
End If
Next
End Function
Code-Sprache: PHP (php)Und hier der Link zum Download des Beispiels. Zur Sicherheit ist der Code digital signiert – das dazugehörige Zertifikat ist im ZIP-Ordner enthalten. Und bitte keine Aufschrei – die im Beispiel enthaltenen Daten sind generierte Testdaten und stammen NICHT von real existierenden Personen 😉