Kopieren mit 2 Dateien aktivieren

        ' Wenn eine Übereinstimmung gefunden wurde, kopiere die Daten aus Spalte A  
        If matchFound Then
            wsTarget.Cells(lastRowTarget, 1).Value = wsSource.Cells(i, 1).Value
            Debug.Print "Kopiert Wert: " & wsSource.Cells(i, 1).Value & " nach Zeile: " & lastRowTarget & " in Zieldatei"  
            lastRowTarget = lastRowTarget + 1
        End If

Sub CopyDataWithCondition2()
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    Dim i As Long
    Dim j As Long
    Dim matchFound As Boolean

    ' Pfade zu den Dateien (Anpassen der Pfade notwendig)  
    Dim sourceFilePath As String
    Dim targetFilePath As String
    sourceFilePath = "C:\Users\Besitzer\Desktop\Vergleich1.xlsm"  
    targetFilePath = "C:\Users\Besitzer\Desktop\Vergleich2.xlsx"  

    On Error GoTo ErrHandler

    ' Öffne die Quelldatei  
    Set wbSource = Workbooks.Open(sourceFilePath)
    If wbSource Is Nothing Then
        MsgBox "Fehler beim Öffnen der Quelldatei.", vbCritical  
        Exit Sub
    End If
    Set wsSource = wbSource.Sheets("Tabelle1") ' Anpassen des Blattnamens falls notwendig  
    If wsSource Is Nothing Then
        MsgBox "Fehler beim Öffnen des Arbeitsblatts in der Quelldatei.", vbCritical  
        Exit Sub
    End If

    ' Öffne die Zieldatei  
    Set wbTarget = Workbooks.Open(targetFilePath)
    If wbTarget Is Nothing Then
        MsgBox "Fehler beim Öffnen der Zieldatei.", vbCritical  
        Exit Sub
    End If
    Set wsTarget = wbTarget.Sheets("Tabelle1") ' Anpassen des Blattnamens falls notwendig  
    If wsTarget Is Nothing Then
        MsgBox "Fehler beim Öffnen des Arbeitsblatts in der Zieldatei.", vbCritical  
        Exit Sub
    End If

    ' Letzte belegte Zeile in der Quelldatei in Spalte A  
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row  
    Debug.Print "Letzte Zeile in der Quelldatei: " & lastRowSource  

    ' Letzte belegte Zeile in der Zieldatei in Spalte A  
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1  
    Debug.Print "Nächste freie Zeile in der Zieldatei: " & lastRowTarget  

    ' Durchlaufen der Zeilen in der Quelldatei  
    For i = 2 To lastRowSource ' Starten bei Zeile 2, falls Zeile 1 Überschriften enthält  
        matchFound = False
        ' Durchlaufen der Zeilen in der Zieldatei, um Übereinstimmung in Spalte C und D zu finden  
        For j = 2 To wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row ' Starten bei Zeile 2, falls Zeile 1 Überschriften enthält  
            If wsSource.Cells(i, 3).Value = wsTarget.Cells(j, 3).Value And wsSource.Cells(i, 4).Value = wsTarget.Cells(j, 4).Value Then
                matchFound = True
                Exit For
            End If
        Next j

        ' Wenn eine Übereinstimmung gefunden wurde, kopiere die Daten aus Spalte A  
        If matchFound Then
            wsTarget.Cells(lastRowTarget, 1).Value = wsSource.Cells(i, 1).Value
            Debug.Print "Kopiert Wert: " & wsSource.Cells(i, 1).Value & " nach Zeile: " & lastRowTarget & " in Zieldatei"  
            lastRowTarget = lastRowTarget + 1
        End If
    Next i

    ' Bestätigungsmeldung anzeigen  
    MsgBox "Daten erfolgreich kopiert.", vbInformation  

    ' Schließen der Arbeitsmappen  
'    wbSource.Close SaveChanges:=False  
'    wbTarget.Close SaveChanges:=True  

    Exit Sub

ErrHandler:
    MsgBox "Fehler: " & Err.Description, vbCritical  
    On Error Resume Next
    If Not wbSource Is Nothing Then wbSource.Close SaveChanges:=False
    If Not wbTarget Is Nothing Then wbTarget.Close SaveChanges:=False
End Sub