Sub Liste_Col3()
Dim d As Object, tablo, j%, i&, x$, a, b, n&
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = [B1].CurrentRegion.Columns(1).Resize(, 2) 'matrice, plus rapide
For j = 1 To 2
For i = 2 To UBound(tablo)
x = tablo(i, j)
If x <> "" Then d(x) = d(x) + 1 'comptage
Next i, j
'---tableau des résultats---
If d.Count Then
ReDim resu(1 To d.Count, 1 To 1)
a = d.keys: b = d.items
For i = 0 To UBound(a)
If b(i) < 2 Then n = n + 1: resu(n, 1) = a(i)
Next i
End If
'---restitution---
With ActiveSheet 'à adapter éventuellement
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
With .[D2] '1ère cellule de destination
If n Then .Resize(n) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub