Das ist eigentlich ziehmlich einfach, steht alles schon drinnen, du musst nur ein paar neue Zellen einfügen (bis auf application.name).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vNew As Variant, vOld As Variant
Dim iRow As Integer
If Intersect(Target, Range("A1:E12")) Is Nothing Then Exit Sub
vNew = Target.Value
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
Application.Undo
vOld = Target.Value
Target.Value = vNew
With Worksheets("Protokollierung")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(iRow, 1).Value = Target(1, 2)
.Cells(iRow, 2).Value = Target.Address(False, False)
.Cells(iRow, 3).Value = vOld
.Cells(iRow, 4).Value = vNew
.Cells(iRow, 5).Value = Application.UserName
End With
ERRORHANDLER:
Application.EnableEvents = True
End Sub
|