Sub Xtractor()
    Dim t As String, i As Long, j As Long
    Dim CH As String
    t = ActiveCell.Text
    j = 1
    If InStr(t, " ") = 0 Then Exit Sub

    ary = Split(t, " ")
    For Each a In ary
        For i = 1 To Len(a)
            CH = Mid(a, i, 1)
            If CH Like "[0-9A-Z]" Then
                ActiveCell.Offset(j, 1).Value = a
                j = j + 1
                Exit For
            End If
        Next i
    Next a
End Sub