Sub Vertical()
Dim i As Long, st As String
i = 1
Dim startP As Range
For Each r In Selection
    If i = 1 Then
        st = r.Text
        i = 2
    Else
        st = st & "," & r.Text
    End If
Next r

Set startP = Selection(1, 2)
ary = Split(st, ",")
i = 1
For Each a In ary
    startP(i, 1).Value = a
    i = i + 1
Next a
End Sub