Sub ListaOutUnique_Kolumn_EE()
Dim Cell As Range, kolumna&, tekst
Dim NoDupes As New Collection
Dim a&, x&, Item As Variant, i&, j&

kolumna = Application.InputBox("Kliknij na dowolną komórkę w wybranej kolumnie", Type:=8).Column
a = WorksheetFunction.CountA(Range(Cells(2, kolumna), Cells(15000, kolumna))) 'zakładamy, że wszystkie komórki są wypełnione

On Error Resume Next
For Each Cell In Range(Cells(2, kolumna), Cells(a + 1, kolumna))
  NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
Set Cell = Application.InputBox("Kliknij na komórkę od której chcesz wpisać dane", Type:=8)
Range(Cell, Cell.Offset(15000, 0)).ClearContents ' czyszczony obszar

ReDim lista(1 To NoDupes.Count)
For i = 1 To NoDupes.Count
lista(i) = NoDupes(i)
Next i

'sortowanie
For i = 1 To UBound(lista) - 1
    For j = i To UBound(lista)
        If lista(i) > lista(j) Then
            tekst = lista(i)
                lista(i) = lista(j)
            lista(j) = tekst
        End If
    Next j
 Next i
Range(Cell, Cell.Offset(i - 1)) = Application.Transpose(lista)
End Sub

Sub ListaOutUnique_Kolumn_EE()
Dim Cell As Range
Dim NoDupes As New Collection
Dim a&, x&, Item As Variant
a = WorksheetFunction.CountA(Range("E2:E15000")) ' Filtrowana kolumna

On Error Resume Next
For Each Cell In Range("E2:E" & a)
  NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

x = 2 ' wiersz od ktorego zapisywany jest gotowy rezultat
Range("O2:P" & 15000).ClearContents ' czyszczony obszar

For Each Item In NoDupes
  Cells(x, 15).Value = Item '17 = kolumny z gotowym rezultatem
  x = x + 1
Next Item

Range("O2:O15000").Select  ' sortowanie rezultatu
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("O2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
            With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("O2:O1500")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub