Sub test1()
Dim RowIndex As Long
Dim StartRow As Long
Dim LastRow As Long
Dim ColumnToMerge As Long
    
    StartRow = 1 ' с какой строки начинать
    ColumnToMerge = 1 ' в какой колонке объединять

    LastRow = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row

    Application.DisplayAlerts = False

    For RowIndex = StartRow + 1 To LastRow
        With Cells(RowIndex, ColumnToMerge)
            If .Value = .Offset(-1, 0).MergeArea.Cells(1).Value Then
                Range(Cells(RowIndex, ColumnToMerge), .Offset(-1, 0)).Merge
            End If
        End With
    Next RowIndex

    Application.DisplayAlerts = True
    
End Sub