Fusionner des mêmes cellules en ligne

Sub fusion()
Dim Lig As Long
Dim co As Long
Dim nbco As Long
Dim plage As Range
Set plage = sheets"(Planning").Range("C22:FQ52") 'A ADAPTER !!!
Application.DisplayAlerts = False
With plage
  nbco = .Columns.Count
  For Lig = .Cells(1, 1).Row To .Cells(1, 1).Row + .Rows.Count - 1
    For co = nbco To 2 Step -1
      If .Cells(Lig, co) = .Cells(Lig, co - 1) Then
        .Range(.Cells(Lig, co), .Cells(Lig, co - 1)).Interior.ColorIndex = 3
      End If
    Next co
  Next Lig
End With
Application.DisplayAlerts = True
End Sub 

Sub fusion3()
Dim Wsh As Worksheet
Dim Lig As Long
Dim PremCol As Long
Dim co As Long
Dim nbco As Long

'A ADAPTER----------------------------------------------
    Lig = 7   'A ADAPTER, ligne ou sont les données
    PremCol = 6  'A ADAPTER, première colonne
    Set Wsh = Worksheets("Planning") ' A ADAPTER Feuille concernée

'TRAITEMENT----------------------------------------------
    Application.ScreenUpdating = False
    nbco = Rows(Lig).Find("*", , , , xlByRows, xlPrevious).Column
    With Wsh
      For co = PremCol To nbco - 1
        If .Cells(7, co) = .Cells(7, co + 1) Then
          .Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ColorIndex = 3
'.Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ThemeColor = xlThemeColorAccent1
'.Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ThemeColor = xlThemeColorAccent5
        Else
            Lig = Lig + 1
            .Cells(Lig, co + 1).Value = .Cells(7, co + 1).Value
        End If
      Next co
    End With
    Application.ScreenUpdating = True
End Sub