XL 2016 Réduction d'un array en fonction d'une condition (suppression doublons)

With wksResultat
.Range("A1").Resize(UBound(arrVariableTableauDefinitif)) = Application.Transpose(arrVariableTableauDefinitif)
End With

Sub CreationListeUniqueDeBinomeCouleur_Forme()
Dim tablo, d As Object, i&
tablo = wksDonnees.[A1].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo): d(tablo(i, 2)) = "": Next
With wksResultat
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If d.Count Then .[A1].Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
    .Range("A" & d.Count + 1 & ":A" & .Rows.Count).ClearContents 'RAZ en dessous
    With .UsedRange: End With 'actualise la barre de défilement verticale
    .Activate 'facultatif
End With
End Sub

Sub Test()
  With wksResultat
    .Activate: Application.ScreenUpdating = False
    .Range("a:a").Clear
    wksDonnees.Range("tabDonnees[Concatenr Couleur-Forme]").Copy
    .Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.RemoveDuplicates Columns:=1, Header:=xlNo
    Application.Goto .Range("a1"), True
  End With
End Sub

Sub Test()
Dim S
S = SujetCBx([tabDonnees[Concatenr Couleur-Forme]])
wksResultat.[A1:A500].ClearContents
wksResultat.[A1].Resize(UBound(S(0)) + 1).Value = WorksheetFunction.Transpose(S(0))
End Sub