Fjern Dubletter VBA style

Option Explicit
Dim Ws As Worksheet
Dim Area As Range
Dim Arr As Variant, Arr2() As Variant
Dim MyCol As New Collection
Dim iRow As Long


Const Ark1 As String = "Ark1" ' Navn på arket med rådata
Const Ark2 As String = "Data" ' Navn på mål arket
Const Område_1 As String = "B2:B100000" ' område på rådata arket
Const Område_2 As String = "K2" ' Første celle på mål arket

Sub KopiUdenDublet()
    Application.ScreenUpdating = False
    Set Ws = Sheets(Ark1)
    Set Area = Ws.Range(Område_1)
    Arr = Area
    On Error Resume Next
    For iRow = LBound(Arr, 1) To UBound(Arr, 1)
        If Arr(iRow) <> "" Then
            MyCol.Add Arr(iRow, 1), Arr(iRow, 1)
        End If
    Next
    On Error GoTo 0
    Erase Arr
    Set Ws = Sheets(Ark2)
    Set Area = Ws.Range(Område_2)
    Range(Area, Area.Offset(99999, 0)).ClearContents
    With MyCol
        ReDim Arr2(1 To .Count)
        For iRow = 1 To .Count
            Area.Offset(iRow - 1, 0) = .Item(iRow)
        Next
    End With
    Application.ScreenUpdating = True
End Sub