suppression automatique d'accent sous vba

Private Sub Workbook_Open()
    If MsgBox("Virer les accents de toutes les feuilles du classeur ?", vbYesNo) = vbYes Then
        For Each sh In ThisWorkbook.Worksheets
            sh.Activate
            virerlesaccentsdelafeuille
        Next sh
    End If
End Sub

Private Sub Workbook_Open()
    If MsgBox("Virer les accents de toutes les feuilles du classeur ?", vbYesNo) = vbYes Then
        For Each sh In ThisWorkbook.Worksheets
            sh.Activate
            virerlesaccentsdelafeuille
        Next sh
    End If
End Sub

Option Explicit
' Définition de la conversion
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"
' La fonction :
Private Function sansAccents(ByRef s As String) As String
Dim i As Integer
Dim lettre As String * 1
  sansAccents = s
  For i = 1 To Len(accent)
    lettre = Mid$(accent, i, 1)
    If InStr(sansAccents, lettre) > 0 Then
       sansAccents = Replace(sansAccents, lettre, Mid$(noAccent, i, 1))
    End If
  Next i
End Function
Public Sub JaiDitPasDaccent()
    Dim c As Range
    If TypeName(Selection) <> "Range" Then
        MsgBox "Vous ne pouvez utiliser cette macro que sur une sélection de cellule!", vbExclamation, "JaiDitPasDaccent"
    Else
        For Each c In Selection
            If TypeName(c.Value) = "String" Then
                If InStr(1, c.Text, "@") > 0 Then
                    'Adresse Mail en minuscule sans accent
                    c = LCase(sansAccents(c.Text))
                Else
                    'Le reste en majuscule sans accent
                    c = UCase(sansAccents(c.Text))
                End If
            End If
        Next
    End If
End Sub