Extract numbers from text into multiple columns

[Rick Rothstein]

Does this macro do what you want...

Sub SplitOutNumbers()
  Dim R As Long, X As Long, LastRow As Long, Text As Variant, Results As Variant
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For R = 1 To LastRow
    Text = Cells(R, "B").Value
    For X = 1 To Len(Text)
      If Mid(Text, X, 1) Like "[!0-9]" Then Mid(Text, X) = " "
    Next
    Text = Split(Application.Trim(Text), " ", 2)
    Cells(R, "C").Resize(, 4).Value = Array(Text(0), Mid(Text(1), 4), Mid(Text(1), 5, 4), Right(Text(1), 1))
  Next
End Sub