Hallo liebes Forum,

ich habe folgenden Sub zusammen geschrieben/kopiert.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count <> 1 Then Exit Sub

If Not Intersect(Range("J10:J1000"), Target) Is Nothing Then
   ActiveSheet.Unprotect "heute"
   Target.Offset(0, 1).Value = Date
   ActiveSheet.Protect "heute"
Else
    If Not Intersect(Target, Range("Z10:Z100")) Is Nothing Then
       ActiveSheet.Unprotect "heute"
       Target.Offset(0, 1) = Target.Offset(0, 1) + 1
       ActiveSheet.Protect "heute"
    If Intersect(Target, Range("Z10:Z101")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect "heute"
    Cells(Cells(Rows.Count, Target.Row - 8).End(xlUp).Row + 1, Target.Row - 8) = Target.Value
    ActiveSheet.Protect "heute"
    End If
End If


End Sub

Interessant wird es gerade bei der Archivierung der Daten. Ich habe ein Feld in dem Datumsangaben von Kundenbesuchen hinterlegt werden und möchte jedesmal wenn ein Datum neu eingegeben wird, das alte in einem extra Sheet hinterlegen lassen.

If Intersect(Target, Range("Z10:Z101")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect "heute"
Cells(Cells(Rows.Count, Target.Row - 8).End(xlUp).Row + 1, Target.Row - 8) = Target.Value
ActiveSheet.Protect "heute"
End If

Innerhalb eines Blattes funktioniert der Code wunderbar. Allerdings bin ich noch sehr unbedarft im Umgang mit VBA und weiß nicht wie ich die Archivierung in einem extra Blatt hinbekomme. Zusätzlich wäre es noch gut wenn ich das Datum mit dem Namen des Außendienstmitarbeiters zusammen bekommen könnte. Die Namen sind nochmal in einer extra Spalte aufgeführt.

Lieben Dank für die Hilfe im Vorraus und viele Grüße,

Christoph