XL 2019 Dico qui garde les doublons

Private Sub CommandButton1_Click()
Dim C As Range, DICO4, R, ZA, cell, i As Long
  
   Set DICO4 = CreateObject("Scripting.Dictionary")
   For Each cell In Feuil1.Range("b2:b" & Feuil1.Cells(Rows.Count, "b").End(xlUp).Row)
      ZA = cell.Value
      If ZA <> "" Then DICO4(ZA) = ""
   Next cell
  
   Application.ScreenUpdating = False
   ReDim t(1 To DICO4.Count, 1 To 1)
   For Each R In DICO4.keys: i = i + 1: t(i, 1) = R: Next
   Feuil1.Range("C:C").ClearContents
   Feuil1.Cells(Rows.Count, "c").End(xlUp).Offset(1).Resize(DICO4.Count) = t
End Sub