Sortir d'une chaine un mot contenant des accents

Option Explicit
Dim mot As String
Private Sub CommandButton1_Click()
 extractionMots
End Sub
'Extraire les données séparées par un espace dans une chaine de caractères
Sub extractionMots()
Dim Chaine As String
Dim Tableau() As String
Dim i As Integer
    Chaine = "Retrouver les caractères accentués dans une chaîne"
    'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Chaine, " ")
    
    'boucle sur le tableau pour visualiser le résultat
    For i = 0 To UBound(Tableau)
        'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
        mot = Tableau(i)
        SupprimerAccents (mot)
       Next i
   End Sub
Function SupprimerAccents(ByVal sChaine As String) As String
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    sTmp = sChaine
    For i = 1 To Len(sTmp)
        p = InStr(sCarAccent, Mid(sTmp, i, 1))
          If p > 0 Then
           MsgBox mot 'mettre le code pour copier le mot dans une autre table [tag]
          End If
        If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
    Next i
   ' SupprimerAccents = sTmp
End Function