Helppo?

moduuliin...

Option Explicit

Sub KorostaJaSiirräTuplat()
Dim solu As Range
Dim Vika As Double
Dim Alue As Range
Dim i As Long
Vika = Range("A65536").End(xlUp).Row
Set Alue = Range("A1:A" & Vika)
i = 1
'tyhjennetään arvot B-sarakkeesta
Range("B:B") = ""

' värjätään tuplat A-sarakkeessa
For Each solu In Alue
If WorksheetFunction.CountIf(Alue, solu.Value) = 1 Then
' ei taustaväriä uniikiarvoille
solu.Interior.ColorIndex = xlNone
Else
' keltainen tupla-arvoille, vaihda värinumeroa tarvittaessa
solu.Interior.ColorIndex = 6
' siirretään tupla-arvot B-sarakkeeseen
' muistettava tarkistaa aluksi tyhjänä oleva alue kanssa!!!
If WorksheetFunction.CountIf(Range("B:B"), solu.Value) = 0 Then
Range("B" & i) = solu.Value
i = i 1
End If
End If
Next solu
'lajitellaan lopuksi
Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End Sub

@Keep Excelling
Kunde