Fusionner 2 cellules sans perdre le contenu

Public Sub fusionne2h()   
Dim t1 As String, t2 As String, t As String   
Dim coul1 As Long, coul2 As Long   
Dim c As Range   
Application.DisplayAlerts = False   
With Selection   
  If .Cells.Count <> 2 Then Exit Sub   
  If .Rows.Count <> 1 Then Exit Sub   
  t1 = .Cells(1, 1): coul1 = .Cells(1, 1).Font.ColorIndex   
  t2 = .Cells(1, 2): coul2 = .Cells(1, 2).Font.ColorIndex   
  t = t1 & " " & t2   
  .MergeCells = True   
  .Value = t   
  .Characters(1, Len(t1)).Font.ColorIndex = coul1   
  .Characters(Len(t1) + 2, Len(t2)).Font.ColorIndex = coul2   
End With   
Application.DisplayAlerts = True   
End Sub