Объединение ячеек столбца таблицы с одинаковым значением

    ' индексы начала-конца группы одинаковых ячеек
    Dim iStart As Integer
    iStart = 0
    Dim iFinish As Integer
    iFinish = 0
    
    ' флаг объединения ячеек
    Dim bMerge As Boolean
    bMerge = False
    
    Dim aCell As Word.Cell
    
    Dim cCells As Cells
    ' извлекаем все ячейки столбца
    Set cCells = ActiveDocument.Tables.Item(1).Columns.Item(1).Cells
        
    ' коллекция для сбора индексов объединяемых ячеек
    Dim cCellsForMerge As New Collection
    
    For Each aCell In cCells
           On Error Resume Next
           
           ' пропускам первую ячейку (начинаем работать со второй)
           If aCell.RowIndex > 1 Then
                ' сравниваем значение с предыдущей
                If aCell.Range.Text = cCells.Item(aCell.RowIndex - 1).Range.Text Then
                        ' при равенстве значений и если нет начала группы iStart = 0, то
                        ' начинаем ее
                        If iStart = 0 Then
                                iStart = aCell.RowIndex - 1
                        End If
                Else
                        ' если значения не равны, то проверяем нужно ли закончить группу
                        If iStart <> 0 Then
                                iFinish = aCell.RowIndex - 1
                                bMerge = True
                        End If
                End If
            End If
            
            ' если достигли конца, завершаем группу
            If iStart <> 0 And aCell.RowIndex = cCells.Count Then
                    iFinish = aCell.RowIndex
                    bMerge = True
            End If
            
            If bMerge Then
                    ' сохраняем индексы в коллекцию
                    cCellsForMerge.Add Item:=iStart
                    cCellsForMerge.Add Item:=iFinish
                                    
                    bMerge = False
                    iStart = 0
            End If
            
    Next aCell
    
    ' значение для пересчета индексов ячеек
    Dim iDelim As Integer
    iDelim = 0
    
    ' перебираем коллекцию индексов объединения
    For i = 1 To cCellsForMerge.Count
            ' очищаем все ячейки из группы кроме первой (иначе одинаковое содержимое будет продублировано)
            Call Selection.SetRange(Start:=cCells(cCellsForMerge(i) - iDelim + 1).Range.Start, End:=cCells(cCellsForMerge(i + 1) - iDelim).Range.End)
            Selection.Range.Select
            For Each iCell In Selection.Cells
                    iCell.Range.Text = ""
            Next iCell
            Selection.Collapse
            ' объединяем ячейки
            Call cCells(cCellsForMerge(i) - iDelim).Merge(cCells(cCellsForMerge(i + 1) - iDelim))
            ' вычисляем значение пересчета
            iDelim = iDelim + cCellsForMerge(i + 1) - cCellsForMerge(i)
            ' прыгаем через ячейку (ведь мы анализируем парами)
            i = i + 1
    Next i