Try something like this

Code:
Function GetUniqueList(rng As Range, ByRef lng As Long)

    Dim var As Variant
    Dim obj As Object
    
    Set obj = CreateObject("Scripting.Dictionary")
    If rng.Columns.Count = 1 Then
        var = rng
        For lng = LBound(var) To UBound(var)
            If Not obj.Exists(var(lng, 1)) Then
                obj.Add var(lng, 1), var(lng, 1)
            End If
        Next lng
    End If
    lng = obj.Count
    GetUniqueList = Application.Transpose(obj.keys)
    
End Function

Sub Test()
    
    Dim lng As Long
    With Worksheets("Sheet2")
        .Range(.Cells(1), .Cells(.Rows.Count, 1).End(xlUp)).Value = Null
        .Cells(1).Resize(lng).Value = GetUniqueList(Worksheets("Sheet1").Range("H1:H" & Worksheets("Sheet1").Cells(Rows.Count, "H").End(xlUp).Row), lng)
    End With
    
End Sub