Sub example_01()
Dim r As Range, i&, j&, t()
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp))
 If Len(r) Then
 ReDim t(1 To Len(r) + Len(r(1, 2)), 1 To 4): j = 0
 For i = 1 To Len(r)
 j = j + 1
 With r.Characters(i, 1).Font
 t(j, 1) = .Name: t(j, 2) = .Bold
 t(j, 3) = .Size: t(j, 4) = .ColorIndex
 End With
 Next i
 For i = 1 To Len(r(1, 2))
 j = j + 1
 With r(1, 2).Characters(i, 1).Font
 t(j, 1) = .Name: t(j, 2) = .Bold
 t(j, 3) = .Size: t(j, 4) = .ColorIndex
 End With
 Next i
 r(1, 3).Value = r & r(1, 2)
 For i = 1 To Len(r(1, 3))
 With r(1, 3).Characters(i, 1).Font
 .Name = t(i, 1): .Bold = t(i, 2)
 .Size = t(i, 3): .ColorIndex = t(i, 4)
 End With
 Next i
 End If
Next r
End Sub