Alte Zellwerte bei Zellwertänderung archivieren
18.05.2015 15:32:21
Christoph
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