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