Ayuda macro funcion Mid excel VB

Hola Buen día.
Tengo esta macro de excel:
Sub selecciono_5()
    ActiveWorkbook.Sheets(3).Activate
Range("A1").Select
While ActiveCell.Value <> ""
       ActiveCell.Offset(1, 0).Select
       ActiveCell.Value = Mid(ActiveCell.Value, 5, 5)
Wend
End Sub
En la hoja tres columna A1 hasta la A20 tengo números con letras con este formato: F- 59784, en números consecutivos, hasta F- XXXXX, con la macro anterior remplazo el contenido de la celda activa solo con los numero quitando la "F- ", lo hace bien lo único malo es que se alentá la hoja de excel al hacer el procedimiento, me gustaría saber como puedo mejorar la macro. Garcías por su tiempo.