fusion cellules ayant même valeur

Sub mergeColonne()
  Application.DisplayAlerts = False
  i = 7
  Do While Cells(i, 1) <> ""
  m = i
  Do While Cells(i, 1) = Cells(m, 1)
    i = i + 1
  Loop
  Cells(m, 1).Resize(i - m).VerticalAlignment = xlCenter
  Cells(m, 1).Resize(i - m).HorizontalAlignment = xlCenter
  Cells(m, 1).Resize(i - m).MergeCells = True
Loop
End Sub

Sub merging()
    Dim i As Long
 Dim nbcol As Long
 
    With Feuil1 'lenomdetafeuille
 
        For i = .Range("A" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 1)) = UCase(.Cells(i - 1, 1)) Then
                .Cells(i - 1, 1) = ""
                .Range(Cells(i, 1), Cells(i - 1, 1)).merge
            End If
        Next i
 
        For i = .Cells(7, .Columns.Count).End(xlToLeft).Column To 2 Step -1
            If UCase(.Cells(7, i)) = UCase(.Cells(7, i - 1)) Then
                .Cells(7, i - 1) = ""
                .Range(Cells(7, i), Cells(7, i - 1)).merge
            End If
        Next i
 
    End With
 
End Sub