Mettre en gras certaine lettre d'une cellule

Private Sub CommandButton1_Click()
    Dim R As Range
    Dim DerniereLigne As Long
    Dim PositionP, PositionM As Integer
    Dim Mot(1) As String
    Dim Lettre As Characters
    
    'Un peu de nettoyage
     ActiveSheet.Range("I2:I65535").ClearContents
     ActiveSheet.Range("I2:I65535").Font.FontStyle = "Normal"
    
    DerniereLigne = ActiveSheet.Range("G:G").End(xlDown).Row
    
    For Each R In ActiveSheet.Range("G2:G" & DerniereLigne)
        
        'Copie de la chaîne de caractères entière
        ActiveSheet.Range("I" & R.Row).Value = R.Text
        
        'Recherche de la position des chaines "p." et "m." (hypothèse : chacune n'apparait qu'une seule fois par ligne)
        PositionP = InStr(ActiveSheet.Range("I" & R.Row).Text, "p.")
        PositionM = InStr(ActiveSheet.Range("I" & R.Row).Text, "m.")
        
        'Mise en gras des chaines "p." et "m."
        ActiveSheet.Range("I" & R.Row).Characters(Start:=PositionP, Length:=2).Font.FontStyle = "Gras"
        ActiveSheet.Range("I" & R.Row).Characters(Start:=PositionM, Length:=2).Font.FontStyle = "Gras"
        
    Next
    
End Sub