One method might be to edit:
Intersect(ActiveSheet.UsedRange, Columns("B"))
With:
Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
Or another method completely if running on large amounts of data might be:
Sub RegexMethod()
Dim rng As Range, values As Variant
Dim r As Long, c As Long, i As Long
Set rng = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
values = rng.Value
With New RegExp
.Pattern = "[^0-9|]"
.MultiLine = True
.Global = True
For r = LBound(values, 1) To UBound(values, 1)
For c = LBound(values, 2) To UBound(values, 2)
values(r, c) = .Replace(values(r, c), vbNullString)
Next
Next
End With
rng = values
End Sub
The above will need a reference added called: 'Microsoft VBScript Regular Expressions 5.5'
Hope this helps