Private Sub Workbook_SheetChange(ByVal Sh as Object, ByVal Target As Range)
Sheets("Protokoll").Unprotect 123
Dim FirstFreeRow As Long
Dim OldVal As Variant
Dim NewVal As Variant
Dim rngNewSel As Range
User = Application.UserName
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("A1:Z999")) Is Nothing Then Exit Sub
Application.EnableEvents = False
NewVal = Target.Value
Set rngNewSel = Selection
Application.Undo
OldVal = Target.Value
Target.Value = NewVal
On Error Resume Next
rngNewSel.Activate
On Error GoTo 0
With Sheets("Protokoll")
FirstFreeRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(FirstFreeRow, 1) = Sh.Name
.Cells(FirstFreeRow, 2) = Target.Address(0, 0)
.Cells(FirstFreeRow, 3) = OldVal
.Cells(FirstFreeRow, 4) = Target.Value
.Cells(FirstFreeRow, 5) = Date
.Cells(FirstFreeRow, 6) = Time
.Cells(FirstFreeRow, 7) = User
End With
Application.EnableEvents = True
Sheets("Protokoll").Protect 123
End Sub