Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow&, lClmn&
Dim iRng As Range
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With Me
  lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  lRow = IIf(lRow < 4, 4, lRow)
  lColmn = .Cells(2, .Columns.Count).End(xlToLeft).Column
  lColmn = IIf(lClmn < 6, 6, lClmn)
  Set iRng = .Range(.Cells(4, 6), .Cells(lRow, lClmn))
  If Not Intersect(Target, iRng) Is Nothing And Target.Count = 1 Then
    If Not Target.MergeCells Then
      If Not IsEmpty(Target) Then
        .Cells(Target.Row, 5) = Format(Date, "dd.mm.yyyy")
      End If
    End If
  End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub