XL 2016 Fusion de cellules selon colonnes différente

Sub test()
    Dim rng As Range, I&, Mot$
    Sheets("TTMT_ITV").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
       .Name = "Résultat"
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Mot = ""
        For I = 2 To Rows.Count 'Cells(Rows.Count, "A").End(xlUp).Row
             If Cells(I, "A") <> Mot Then
                If Not rng Is Nothing Then
                    With rng.Offset(, 3):: .MergeCells = True: End With
                    With rng.Offset(, 4):: .MergeCells = True: End With
                    With rng.Offset(, 5):: .MergeCells = True: End With
                End If

                 Set rng = Cells(I, "A")
                Mot = Trim(Cells(I, "A"))
            Else
                Set rng = Union(rng, Cells(I, "a"))
             
              End If
        If Cells(I, "A") = "" Then Exit For 'on sort des que l'on atteint une cellule vide
           Next
    End With
End Sub

 For I = 2 To .UsedRange.Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row

Sub test2()
    Dim rng As Range, I&, couleur(2)
    Sheets("TTMT_ITV").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "Résultat"
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        couleur(0) = RGB(255, 255, 255)
        couleur(1) = RGB(215, 215, 215)
        For I = 2 To Cells(Rows.Count, "A").End(xlUp).Row
            If Cells(I, "A") <> Cells(I - 1, "A") Then x = IIf(x = 0, 1, 0)
            Cells(I, "A").Resize(, 100).Interior.Color = couleur(x)
        Next
    End With
End Sub

Sub fusion()
    Dim datas, lig As Long, nblig As Long, col As Long
    datas = [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1).Value
    Application.DisplayAlerts = False
    For lig = 1 To UBound(datas)
        nblig = Application.CountIf(Columns(1), datas(lig, 1))
        If nblig > 1 Then
            For col = 4 To 6
                Cells(lig + 1, col).Resize(nblig).MergeCells = True
            Next col
        End If
        lig = lig + nblig - 1
    Next lig
End Sub