|  
                                             
	Moin! Also dann hier der Code so angepasst. Jetzt wird nur noch der alte Liefertermin, die Änderungszeit und der Username aus der Anmeldung eingetragen. Falls da ich nur den letzten Code etwas angepasst habe, ist noch ein bissl Codebalast drin. Falls du Änderungen vorher nicht brauchst sondern nur den neuen Liefertermn,  poste ich gleich noch ne abgespeckte Variante. VG 
	  
Option Explicit
Public altewerte
 
Private Sub Worksheet_Activate()
Dim letzte As Long
Dim neu
letzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 
altewerte = ActiveSheet.Range("A1:M" & letzte)
 
 
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim letzte As Long
Dim zeile As Long
Dim zeile2 As Long
Dim i As Long
 
letzte = ActiveSheet.Cells(Rows.Count, 12).End(xlUp).Row
If Target.Count > 1 Then
letzte = ActiveSheet.Cells(Rows.Count, 12).End(xlUp).Row
altewerte = ActiveSheet.Range("A1:M" & letzte)
 
Else
    If Not Intersect(Target, ActiveSheet.Columns(12)) Is Nothing Then
        zeile = Target.Row
        zeile2 = Worksheets("Protokoll").Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Range(ActiveSheet.Cells(zeile, 1), ActiveSheet.Cells(zeile, 6)).Copy Worksheets("Protokoll").Range("A" & zeile2 + 1)
        ActiveSheet.Range("L" & zeile).Copy Worksheets("Protokoll").Range("G" & zeile2 + 1)
        
        'alter Liefertermin
        Worksheets("Protokoll").Cells(zeile2 + 1, 15) = altewerte(zeile, 12)
        'Änderungszeit
        Worksheets("Protokoll").Cells(zeile2 + 1, 16) = Now
        'Name des Ändernden
        Worksheets("Protokoll").Cells(zeile2 + 1, 17) = Environ("Username")
        Worksheets("Protokoll").Columns(16).AutoFit
    Else
        altewerte = ActiveSheet.Range("A1:M" & letzte)
    End If
End If
End Sub
	  
     |