Ausgangsbasis:
Alle Einträge aus sheet "Antrieb" Spalte C soll in sheet "Beförderung" Spalte C kopiert werden (ans ende der liste), wenn der Eintrag dort noch nicht vorhanden ist.
Der Code:
Sub Übertrag_in_Beförderung()
Dim EintragCheck1 As Variant
Dim eintragCheck2 As Variant
Dim EndeEintraegeBF
Dim EndeEintraegeAN
'Suche letzten Eintrag in jeweiligen sheet und Spalte 3 hier
EndeEintraegeAN = Sheets("Antrieb").Cells(Rows.Count, 3).End(xlUp).Row
EndeEintraegeBF = Sheets("Beförderung").Cells(Rows.Count, 3).End(xlUp).Row
'EintragCheck1 = Sheets("Antrieb").Cells(1, 3).Value
'Aktualisierung der Anzeige von Excel abgeschaltet, Durchlauf Schleifen nicht zu sehen
Application.ScreenUpdating = False
LeereZeile = EndeEintraegeBF + 1
For j = 2 To EndeEintraegeAN
EintragCheck1 = Sheets("Antrieb").Cells(j, 3).Value
For i = 2 To EndeEintraegeBF
eintragCheck2 = Sheets("Beförderung").Cells(i, 3).Value
If EintragCheck1 eintragCheck2 Then
'hier drunter kommt was kopiert werden soll, wie wählt man Eintrag i aus zum kopieren?
Sheets("Antrieb").Range("C" & i).Copy
'auswahl wohin kopiert werden soll funktioniert
Sheets("Beförderung").Range("C" & LeereZeile).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Weder im Ausschneide- noch im Kopiermodus
Application.CutCopyMode = False
'neue letzte Zeile und nachfolgende berechnen
EndeEintraegeBF = Sheets("Beförderung").Cells(Rows.Count, 1).End(xlUp).Row
LeereZeile = EndeEintraegeBF + 1
Else
MsgBox "Eintrag schon vorhanden"
Exit For
End If
Next i
Next j
'Aktualisierung der Anzeige von Excel abgeschaltet
Application.ScreenUpdating = True
End Sub
Leider wird aktuell immer nur der letzte Eintrag kopiert.
Wenn der Eintrag vorhanden ist soll er nichts kopieren und sich den nächsten Wert zum überprüfen schnappen.