Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleurs

=STXT(" "&$A1&" ";TROUVE("*";SUBSTITUE(" "&$A1&" ";" ";"*";COLONNES($B:B)))+1;TROUVE("+";SUBSTITUE(" "&$A1&" ";" ";"+";COLONNES($B:C)))-1)

Dim DerLign As Integer
Dim I As Integer
Dim Pos As Byte
Dim Prenom As String
Dim Nom As String

DerLign = Range("A1000").End(xlUp).Row

For I = 1 To DerLign
    For Pos = 1 To Len(Cells(I, 1).Text)
        If Cells(I, 1).Characters(Pos, 1).Font.Bold Then
            Prenom = Trim(Left(Cells(I, 1), Pos - 1))
            Nom = Trim(Right(Cells(I, 1), Len(Cells(I, 1)) - Pos + 1))
            Cells(I, 2) = Nom
            Cells(I, 1) = Prenom
            GoTo Suite
        End If
    Next Pos
Suite:
Next I

Function extraitGras(c)
   Application.Volatile
   For i = 1 To Len(c)
       If c.Characters(Start:=i, Length:=1).Font.Bold = True Then
         temp = temp & Mid(c, i, 1)
       End If
    Next i
    extraitGras = temp
End Function

Function extraitNonGras(c)
   Application.Volatile
   For i = 1 To Len(c)
       If c.Characters(Start:=i, Length:=1).Font.Bold = False Then
         temp = temp & Mid(c, i, 1)
       End If
    Next i
    extraitNonGras = temp
End Function

Sub test()
Dim DerLig&, i As Byte, j As Byte
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To DerLig Step 8
    For j = 1 To Len(Cells(i, 1))
        If Cells(i, 1).Characters(Start:=j, Length:=1).Font.Bold = True Then
            Cells(i, 1).Offset(, 1) = Left(Cells(i, 1), j - 1)
            Cells(i, 1).Offset(, 2) = Right(Cells(i, 1), Len(Cells(i, 1)) - j + 1)
            Exit For
        End If
    Next j
Next i
End Sub