Historique saisie feuilles excel

Option Explicit
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim dic As Object, clé As Variant
Dim sel As Range, act As Range, tgt As Range, usr As Range, cel As Range
Dim val As Variant
Dim n°L As Long

  If sh.Name <> "Modifications" Then
    Set dic = CreateObject("Scripting.Dictionary")
    'Mémoriser le contexte initial
    Set sel = Selection
    Set act = ActiveCell
    With Worksheets("Modifications")
      'Mémoriser les nouvelles valeurs non vides
      Set usr = Intersect(Target, sh.UsedRange)
      If Not usr Is Nothing Then
        val = usr.Value
        For Each cel In usr.Cells
          If cel.Formula <> "" Then
            dic(cel.Address) = cel.Value
          End If
        Next cel
      End If
      Application.EnableEvents = False
      Application.Undo
      Set tgt = Intersect(Target, sh.UsedRange)
      If Not tgt Is Nothing Then
        For Each cel In tgt.Cells
          n°L = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
          If dic.Exists(cel.Address) Then
            If cel.Value <> dic(cel.Address) Then
              .Cells(n°L, 1).Value = sh.Name
              .Cells(n°L, 2).Value = cel.Address
              .Cells(n°L, 3).Value = Now
              .Cells(n°L, 4).Value = cel.Value
              .Cells(n°L, 5).Value = dic(cel.Address)
              .Cells(n°L, 6).Value = Environ("username")
            End If
            dic.Remove cel.Address
          Else
            .Cells(n°L, 1).Value = sh.Name
            .Cells(n°L, 2).Value = cel.Address
            .Cells(n°L, 3).Value = Now
            .Cells(n°L, 4).Value = cel.Value
            .Cells(n°L, 5).Value = ""
            .Cells(n°L, 6).Value = Environ("username")
          End If
        Next cel
      End If
      If dic.Count > 0 Then
        For Each clé In dic.Keys
          n°L = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
          .Cells(n°L, 1).Value = sh.Name
          .Cells(n°L, 2).Value = clé
          .Cells(n°L, 3).Value = Now
          .Cells(n°L, 4).Value = sh.Range(clé).Value
          .Cells(n°L, 5).Value = dic(clé)
          .Cells(n°L, 6).Value = Environ("username")
        Next clé
        dic.RemoveAll
      End If
      Target.ClearContents
      If Not usr Is Nothing Then usr.Value = val
    End With
    'Rétablir le contexte initial
    sel.Select
    act.Activate
    Application.EnableEvents = True
  End If
End Sub