Sub ExtractNumbers()
Dim j As String, k As Long, m As Long
Dim r As Range, c As Range
Set r = ActiveSheet.UsedRange.Columns("A")
Columns("B:B").Cells.Clear
For Each c In r.Cells
j = ""
For m = 1 To Len(c.Value)
If IsNumeric(Mid(c, m, 1)) Then j = j & Mid(c, m, 1)
Next m
c.Offset(0, 1).Value = Conversion.CInt(j)
Next c
End Sub