Hallo M.O.
Sorry, habe einen Fehler gemacht und einen neuen Thread geöffnet.
Hallo M.O.
Quellcode in der Quell Excel Tabelle 1:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'im Klassenmodul des Blattes "Daten"
Dim rngVeränderung As Range
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim rngSuche As Range
Set wsQuelle = Worksheets("Daten")
Set wsZiel = Worksheets("Beschläge")
If Not Intersect(Target, Columns("E")) Is Nothing Then
For Each rngVeränderung In Intersect(Target, Columns("E"))
If UCase(rngVeränderung) = "X" Then 'Wenn ein "X" gesetzt wurde
'Prüfen, ob Wert in Zieltabelle vorhanden
With wsZiel
Set rngSuche = .Columns("A").Find(wsQuelle.Cells(rngVeränderung.Row, 1), lookat:=xlWhole)
End With
If rngSuche Is Nothing Then 'Wenn Wert aus Spalte A nicht gefunden wurde...
With wsQuelle
.Cells(rngVeränderung.Row, "A").Resize(, 4).Copy _
Destination:=wsZiel.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Else 'Datensatz existiert bereits
MsgBox "Der Datensatz " & wsQuelle.Cells(rngVeränderung.Row, 1) & " existiert bereits!"
End If
ElseIf IsEmpty(rngVeränderung) Then 'Wenn das "X" gelöscht wurde bzw. die Zelle leer ist
'Prüfen, ob Wert in Zieltabelle vorhanden ist
With wsZiel
Set rngSuche = .Columns("A").Find(wsQuelle.Cells(rngVeränderung.Row, 1), lookat:=xlWhole)
End With
If Not rngSuche Is Nothing Then 'Wert gefunden
rngSuche.EntireRow.Delete
End If
End If
Next rngVeränderung
End If
Set rngSuche = Nothing
Set wsZiel = Nothing
Set wsQuelle = Nothing
End Sub
Gruß Berpre
