Sub GetListBox()
    Dim AllCells As Range, rCell As Range, NoDupes As New Collection, i As Long, j As Long
    Dim Swap1, Swap2, Item
    'Элементы находятся в столбце A
    Set AllCells = ActiveSheet.Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
    'заполняем коллекцию элементами без повторений
    On Error Resume Next
    For Each rCell In AllCells
        NoDupes.Add rCell.Value, CStr(rCell.Value)
    Next rCell
    On Error GoTo 0
    'Сортируем элементы коллекции по возрастанию
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i): Swap2 = NoDupes(j)
                NoDupes.Add Swap1, Before:=j: NoDupes.Add Swap2, Before:=i
                NoDupes.Remove i + 1: NoDupes.Remove j + 1
            End If
        Next j
    Next i
    With NoDupes
        ReDim Arr(1 To .Count)
        For i = 1 To .Count
            Arr(i) = .Item(i)
        Next
    End With
    UserForm1.ListBox1.List = Arr
End Sub