XL 2019 amélioration d'une macro (actualisation auto et automatisation)

Sub SansDoublonsTrié()
  Dim temp()
  Set f = ActiveSheet
  Set mondico = CreateObject("Scripting.Dictionary")
  a = Range(f.[$B$2], f.[$B$212].End(xlUp)).Value
  For Each c In a
     mondico(c) = ""
  Next c
  Set dest = f.Range("$P$60")
  dest.Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  dest.Resize(mondico.Count, 1).Sort Key1:=dest, Order1:=xlAscending
  Set mondico = Nothing ' libère mondico
End Sub

Sub Worksheet_Activate()
    SansDoublonsTrié
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ' Si la feuille n'est pas un mois, on sort
  If InStr(1, "janvier,février,mars,avril,mai,juin,juillet,août,septembre,novembe,décembre", Sh.Name, vbTextCompare) > 0 Then
    Call SansDoublonsTrié(Sh)
  End If
End Sub

Sub SansDoublonsTrié(Sh As Worksheet)
  Dim temp()
  Set mondico = CreateObject("Scripting.Dictionary")
  a = Range(Sh.[ligne1_liste_tiers], Sh.[ligne_finale_liste_tiers].End(xlUp)).Value
  For Each c In a
     mondico(c) = ""
  Next c
  Set dest = Sh.Range("synthèse_1e_ligne")
  dest.Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  dest.Resize(mondico.Count, 1).Sort Key1:=dest, Order1:=xlAscending
  Set mondico = Nothing ' libère mondico
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Range("C:C").WrapText = True

If Not Application.Intersect(Target, Range("TIERS")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    SansDoublonsTrié
End If
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsDate("1/" & Sh.Name) Then
    Sh.Range("C:C").WrapText = True
    If Not Application.Intersect(Target, Sh.[B2].Resize(211)) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each Target In Target.Areas 'si entrées ou effacements multiples
            Target = UCase(Target)
        Next
        SansDoublonsTrié1 Sh
        Application.EnableEvents = True
    End If
End If
End Sub

Sub SansDoublonsTrié1(Sh As Object)
With Sh.[P60].Resize(211)
    .Value = Sh.[B2].Resize(211).Value
    .RemoveDuplicates Columns:=1, Header:=xlNo
    .Sort .Columns(1), xlAscending, Header:=xlNo
End With
End Sub

If Target.Count > 1 Then Exit Sub