Sub ABC()
Dim sArr(), Res() As String, iChar$
Dim i&, N&, j&, j2&, k&, jC&
sArr = Range("A5", Range("A" & Rows.Count).End(xlUp)).Value
srow = UBound(sArr)
ReDim Res(1 To srow, 1 To 10)
For i = 1 To srow
tmp = sArr(i, 1)
N = Len(tmp)
jC = 0
For j = 1 To N - 6
If IsNumeric(Mid(tmp, j, 1)) Then
k = 1
For j2 = j + 1 To N
iChar = Mid(tmp, j2, 1)
If IsNumeric(iChar) Or iChar = " " Then
k = k + 1
Else
j2 = j2 + 1: Exit For
End If
Next j2
If k > 5 Then
jC = jC + 1
Res(i, jC) = Trim(Mid(tmp, j, k))
End If
j = j2 - 1
End If
Next j
Next i
Range("B5").Resize(srow, 10) = Res
End Sub