Macro Eliminar caracteres acentuados en Excel

La siguiente macro permite eliminar todos los caracteres acentuados del rango seleccionado. Esto facilita la manipulación y comparación de textos, ya que por lo regular es recomendable utilizar texto sin acentuaciones en bases de datos:

Macro:

Sub EXCELeINFOReplaceAccentedCharacters()
Application.StatusBar = "Reemplazando caracteres acentuados..."
Application.ScreenUpdating = False
'
With Selection
'a
    .Replace What:="á", Replacement:="a", MatchCase:=True
    .Replace What:="à", Replacement:="a", MatchCase:=True
    .Replace What:="â", Replacement:="a", MatchCase:=True
    .Replace What:="ä", Replacement:="a", MatchCase:=True
    .Replace What:="ã", Replacement:="a", MatchCase:=True
    .Replace What:="å", Replacement:="a", MatchCase:=True
'c
    .Replace What:="ç", Replacement:="c", MatchCase:=True
'e
    .Replace What:="é", Replacement:="e", MatchCase:=True
    .Replace What:="è", Replacement:="e", MatchCase:=True
    .Replace What:="ê", Replacement:="e", MatchCase:=True
    .Replace What:="ë", Replacement:="e", MatchCase:=True
'i
    .Replace What:="í", Replacement:="i", MatchCase:=True
    .Replace What:="ì", Replacement:="i", MatchCase:=True
    .Replace What:="î", Replacement:="i", MatchCase:=True
    .Replace What:="ï", Replacement:="i", MatchCase:=True
'o
    .Replace What:="ó", Replacement:="o", MatchCase:=True
    .Replace What:="ò", Replacement:="o", MatchCase:=True
    .Replace What:="ô", Replacement:="o", MatchCase:=True
    .Replace What:="ö", Replacement:="o", MatchCase:=True
    .Replace What:="õ", Replacement:="o", MatchCase:=True
    .Replace What:="ð", Replacement:="o", MatchCase:=True
's
    .Replace What:="š", Replacement:="s", MatchCase:=True
'u
    .Replace What:="ú", Replacement:="u", MatchCase:=True
    .Replace What:="ù", Replacement:="u", MatchCase:=True
    .Replace What:="û", Replacement:="u", MatchCase:=True
    .Replace What:="ü", Replacement:="u", MatchCase:=True
'y
    .Replace What:="ý", Replacement:="y", MatchCase:=True
    .Replace What:="ÿ", Replacement:="y", MatchCase:=True
'z
    .Replace What:="ž", Replacement:="z", MatchCase:=True
'A
    .Replace What:="Á", Replacement:="A", MatchCase:=True
    .Replace What:="À", Replacement:="A", MatchCase:=True
    .Replace What:="Â", Replacement:="A", MatchCase:=True
    .Replace What:="Ä", Replacement:="A", MatchCase:=True
    .Replace What:="Ã", Replacement:="A", MatchCase:=True
    .Replace What:="Å", Replacement:="A", MatchCase:=True
'C
    .Replace What:="Ç", Replacement:="C", MatchCase:=True

    .Replace What:="É", Replacement:="E", MatchCase:=True
    .Replace What:="È", Replacement:="E", MatchCase:=True
    .Replace What:="Ê", Replacement:="E", MatchCase:=True
    .Replace What:="Ë", Replacement:="E", MatchCase:=True
'I
    .Replace What:="Í", Replacement:="I", MatchCase:=True
    .Replace What:="Ì", Replacement:="I", MatchCase:=True
    .Replace What:="Î", Replacement:="I", MatchCase:=True
    .Replace What:="Ï", Replacement:="I", MatchCase:=True
'O
    .Replace What:="Ó", Replacement:="O", MatchCase:=True
    .Replace What:="Ò", Replacement:="O", MatchCase:=True
    .Replace What:="Ô", Replacement:="O", MatchCase:=True
    .Replace What:="Ö", Replacement:="O", MatchCase:=True
    .Replace What:="Õ", Replacement:="O", MatchCase:=True
    .Replace What:="Ð", Replacement:="O", MatchCase:=True
'S
    .Replace What:="Š", Replacement:="S", MatchCase:=True
'U
    .Replace What:="Ú", Replacement:="U", MatchCase:=True
    .Replace What:="Ù", Replacement:="U", MatchCase:=True
    .Replace What:="Û", Replacement:="U", MatchCase:=True
    .Replace What:="Ü", Replacement:="U", MatchCase:=True
'Y
    .Replace What:="Ý", Replacement:="Y", MatchCase:=True
    .Replace What:="Ÿ", Replacement:="Y", MatchCase:=True
'Z
    .Replace What:="Ž", Replacement:="Z", MatchCase:=True
End With
'
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub