' индексы начала-конца группы одинаковых ячеек 
    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 
         
    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 
              ' объединяем (нужен код)                                     
              bMerge = False 
              MsgBox iStart & " - " & iFinish 
              iStart =  0  
            End If             
    Next aCell