Wie kopiert man Zeilen aus mehreren Arbeitsblättern anhand bestimmter Kriterien in ein neues Arbeitsblatt?

Angenommen, Ihre Arbeitsmappe enthält drei Arbeitsblätter mit identischer Formatierung wie im folgenden Screenshot dargestellt. Wie können Sie alle Zeilen, in deren Spalte C der Text „Completed“ steht, schnell und einfach in ein neues Arbeitsblatt kopieren – ohne jede Zeile manuell einzeln zu übertragen?

Zeilen aus mehreren Arbeitsblättern basierend auf Kriterien mithilfe von VBA-Code in ein neues Blatt kopieren

---

Zeilen aus mehreren Arbeitsblättern basierend auf Kriterien mithilfe von VBA-Code in ein neues Blatt kopieren

Der folgende VBA-Code unterstützt Sie dabei, bestimmte Zeilen aus allen Arbeitsblättern der Arbeitsmappe – basierend auf einer festgelegten Bedingung – in ein neues Arbeitsblatt zu kopieren. Gehen Sie dazu wie folgt vor:

1. Halten Sie die Tasten ALT + F11 gedrückt, um das Fenster Microsoft Visual Basic für Applikationen zu öffnen.

2. Klicken Sie auf Einfügen > Modul, und fügen Sie den folgenden Code in das Modulfenster ein.

VBA-Code: Zeilen aus mehreren Blättern basierend auf Kriterien in ein neues Blatt kopieren

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

Hinweis: Im obigen Code:

• Der Text „Completed“ in diesem xRStr = „Completed"Skript gibt die spezifische Bedingung an, nach der Zeilen kopiert werden sollen;
• C:C in diesem Set xRg = xWs.Range(„C:C")-Skript gibt die Spalte an, in der sich die Bedingung befindet.

3. Drücken Sie anschließend die F5-Taste, um diesen Code auszuführen. Alle Zeilen mit der spezifischen Bedingung wurden kopiert und in ein neues Arbeitsblatt mit dem Namen „Kutools für Excel“ innerhalb der aktuellen Arbeitsmappe eingefügt. Siehe Screenshot:

---

---

Weitere verwandte Artikel zum Abrufen oder Kopieren von Daten: