Sub uniq()

Dim Arr(), x, cnt

Arr() = Columns( 1 ).Value
On Error GoTo wr_
With CreateObject("Scripting.Dictionary")
For Each x In Arr()
cnt = cnt +  1 
If Len(x) >  0  Then .Add x,  0 
Next
End With
wr_:
Cells(cnt,  2 ).Value = Cells(cnt,  1 ).Value
Debug.Print x
Resume Next
End Sub

wr_:
Cells(cnt,  2 ).Value = Cells(cnt,  1 ).Value
Cells(cnt,  1 ).Value = ""
Resume Next
End Sub

Sub copy_nonuniq2()

Dim cnt As Long
Dim source_ As Object
Dim sLastRow&
Dim cc As Range

Set source_ = Sheets( 1 )
sLastRow = source_.Cells(Rows.Count,  1 ).End(xlUp).Row 'привязка к 1 колонке
Dim ra As Range: Set ra = source_.Range(source_.[a1], source_.Cells(sLastRow,  1 )) 'привязка к 1 колонке

On Error GoTo wr_
With CreateObject("Scripting.Dictionary")
For Each cc In ra.Cells
cnt = cnt +  1 
If Len(cc.Value) >  0  Then .Add cc.Value,  0 
Next
End With
Exit Sub
wr_:
Cells(cnt,  2 ).Value = Cells(cnt,  1 ).Value
Cells(cnt,  1 ).Value = ""
'Debug.Print x
Resume Next

End Sub

Sub copy_nonuniq3()

Dim source_ As Object
Dim sLastRow&
Dim cc As Range

Set source_ = Sheets( 1 )
sLastRow = source_.Cells(Rows.Count,  1 ).End(xlUp).Row 'привязка к 1 колонке
Dim ra As Range: Set ra = source_.Range(source_.[a1], source_.Cells(sLastRow,  1 )) 'привязка к 1 колонке

On Error GoTo wr_
With CreateObject("Scripting.Dictionary")
For Each cc In ra.Cells
If Len(cc.Value) >  0  Then .Add cc.Value,  0 
Next
End With
Exit Sub
wr_:
Cells(cc.Row,  2 ).Value = Cells(cc.Row,  1 ).Value
Cells(cc.Row,  1 ).Value = ""
Resume Next

End Sub