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
|