Código:
Sub QuitarEspacios()
Dim r As Range
On Error Resume Next
Set r = Application.InputBox("Selecciona el rango donde deseas quitar los espacios", "Aprendiendo ẽXcel365", Type:=8)
On Error GoTo 0
If r Is Nothing Then
Exit Sub
End If
For Each celda In r
celda.Value = Application.WorksheetFunction.Trim(celda.Value)
Next celda
MsgBox "Se han eliminado los espacios en el rango seleccionado.", , "Aprendiendo ẽXcel365"
End Sub