Extraer un número de celular de una cadena de texto (celda)

Ya volví, te anexo la macro
Instrucciones
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5
'***Macro, extrae números de celular de una cadena
Sub celular()
'Por.Dam
ufila = Range("A" & Rows.Count).End(xlUp).Row
cuentacel = 0
Range("B2:B" & ufila).ClearContents
For i = 2 To ufila
largo = Len(Cells(i, 1))
For j = 1 To largo
tres = Mid(Cells(i, 1), j, 1)
If tres = 3 Then
inicio = j
num = tres
contador = 1
For k = j + 1 To largo
signum = Mid(Cells(i, 1), k, 1)
If Not IsNumeric(signum) Then
j = k
Exit For
Else
contador = contador + 1
num = num & signum
If contador = 10 Then
signum = Mid(Cells(i, 1), k + 1, 1)
If Not IsNumeric(signum) Then
If cuentacel = 0 Then
Cells(i, 2) = num
Else
Cells(i, 2) = Cells(i, 2) & " y " & num
End If
cuentacel = cuentacel + 1
j = k
Exit For
End If
End If
End If
Next k
End If
Next j
If cuentacel = 0 Then
Cells(i, 2) = "No tiene celular"
End If
cuentacel = 0
Next i
End Sub
'***Macro
La macro tiene lo siguiente:
1. No considera números que no empiecen con 3
2. No considera números menores a 10
3. No considera números mayores a 10
4. Considera varios números y los pone en la columna B
5. Si no tiene número, pone la leyenda "No tiene celular"
Saludos. Dam