Sub Separe()
Dim cel As Range, i As Long, txt$, c As New Collection
[B2:B65536].ClearContents
On Error Resume Next
For Each cel In Range([A2], [A65536].End(xlUp))
For i = 0 To Len(cel) - Len(Replace(cel, " ", ""))
txt = Split(cel, " ")(i)
c.Add txt, txt
Next
Next
For i = 1 To c.Count
Range("B" & i + 1) = c(i)
Next
[B2:B65536].Sort Key1:=[B2], Order1:=xlAscending, Header:=xlNo
End Sub