Option Explicit
Private Sub Document_Open()
Const OKTMO = "Выберите элемент.|ТК ПЭК |" & _
"ТК ДЕЛОВЫЕ ЛИНИИИ|ТК ЭНЕРГИЯ|" & _
"ТК ЖЕЛДОРЭКСПЕДИЦИЯ "

  With ActiveDocument.InlineShapes(1).OLEFormat.Object
    .List = Split(OKTMO, "|")
    .ListIndex = 0
  End With
End Sub

Sub coloring()
    Dim MyRange As Range
    Set MyRange = Union(Range("a4:J300"), Range("a4:J300"))
    MyRange.Select
    Call DuplicatesColoring
    MyRange.Interior.ColorIndex = xlNone
End Sub

Sub jjj()
    start_row = 4
    end_row = Cells(Rows.Count, 2).End(xlUp).Row
    Set rng_orign = Range(Cells(start_row, 1), Cells(end_row, 2))
    Set rng_dbls = ThisWorkbook.Worksheets("ДУБЛИ (2)").[A1]
    start_col_c = 3
    end_col_c = 10
    For i = start_row To end_row
        out_col_offset = 0
        For j = start_col_c To end_col_c
            If Len(Cells(i, j).Value) > 0 Then
                Set cl = rng_orign.Rows(i - start_row + 1).Find(what:=Cells(i, j).Value, _
                    LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                If Not cl Is Nothing Then
                    rng_dbls.Offset(, out_col_offset).Value = Cells(i, j).Value
                    Cells(i, j).ClearContents
                    out_col_offset = out_col_offset + 1
                    Call DuplicatesColoring
                    MyRange.Interior.ColorIndex = xlNone
                End If
            End If
        Next j
        Set rng_dbls = rng_dbls.Offset(1)
    Next i
End Sub

MyRange.Interior.ColorIndex = xlNone