Excel: concatenation et format

Public Function IsBoldItalic(ByVal MyRange As Range) As String
    Dim rCell As Range
    
For Each rCell In MyRange
    IsBoldItalic = IsBoldItalic & rCell.Address & " :" & vbCrLf
    IsBoldItalic = IsBoldItalic & vbTab & "Gras : " & CBool(rCell.Font.Bold) & vbCrLf
    IsBoldItalic = IsBoldItalic & vbTab & "Italique : " & CBool(rCell.Font.Italic) & vbCrLf
Next rCell
End Function
Sub EXEMPLE()
    Debug.Print IsBoldItalic(Range("A1:A4"))
    
'       *** RESULTAT :  ***
'$A$1 :
'    Gras : Faux
'    Italique :  Faux
'$A$2 :
'    Gras : Vrai
'    Italique :  Faux
'$A$3 :
'    Gras : Faux
'    Italique :  Vrai
'$A$4 :
'    Gras : Vrai
'    Italique :  Vrai
End Sub

Const LF As String = "vblf"
Sub RecupFormatCel()
    Dim c1 As Range, c2 As Range, dest As Range
    Dim i As Integer, long1 As Long, ptr1 As Long, ptr2 As Long
    Dim formatCel As Variant
    Dim ListeRef As Variant
    For Each c1 In Selection
        f = c1.Formula
        If Left(f, 1) <> "=" Then 'formule ?
            Exit Sub
        Else
            f = Mid(c1.Formula, 2) 'oui: eliminer =
        End If
        Set dest = c1.Offset(0, 1) 'cellule de destination
        dest.Value = c1.Value
        ListeRef = Split(f, "&") ' découper la formule
        '
        ' remplacement des "vbLF" par vbLf
        While InStr(1, LCase(dest.Value), LF)
            pos = InStr(1, LCase(dest.Value), LF)
            dest = Left(dest.Value, pos - 1) & vbLf & Mid(dest.Value, pos + Len(LF))
        Wend

        ' récupération des formats
        ptr1 = 1
        For i = 0 To UBound(ListeRef)
            Set c2 = Range(ListeRef(i)) ' adresse de la chaine
            long1 = Len(c2.Value) ' longueur de la chaine
            'ptr2 = ptr2 + long1
            If LCase(c2.Value) = LF Then
                ' traitement vbLF
                long1 = 1
            Else
                With c2.Font
                    formatCel = .FontStyle
                    dest.Characters(Start:=ptr1, Length:=long1).Font.FontStyle = formatCel
                    formatCel = .ColorIndex
                    dest.Characters(Start:=ptr1, Length:=long1).Font.ColorIndex = formatCel
                    formatCel = .Underline
                    dest.Characters(Start:=ptr1, Length:=long1).Font.Underline = formatCel

                End With
            End If
            ptr1 = ptr1 + long1
        Next i
    Next c1
End Sub
Sub test()
    Range("H3:H5,H7:H8").Select
    RecupFormatCel
End Sub
Sub raz()
    Range("I3:I8").ClearContents
End Sub