синхронизация пунктов двух раскрывающихся списков

Sub SyncContentControlByValue(Src As ContentControl, Dest As ContentControl)
 
Dim SrcT As String
Dim SrcV As String
Dim ccLE As ContentControlListEntry
 
SrcT = Src.Range.Text
 
For i = 1 To Src.DropdownListEntries.Count
    If SrcT = Src.DropdownListEntries.Item(i).Text Then
         
        SrcV = Src.DropdownListEntries.Item(i).Value
         
        For k = 1 To Dest.DropdownListEntries.Count
            If Dest.DropdownListEntries.Item(k).Value = SrcV Then
                Dest.DropdownListEntries.Item(k).Select
                Exit Sub
            End If
        Next
         
        ' Если не найден выбираем первый
        Dest.DropdownListEntries.Item(1).Select
    End If
Next
 
End Sub 

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    Dim ccI As ContentControl
    Dim ccK As ContentControl
     
    Set ccI = ActiveDocument.SelectContentControlsByTag("исполнитель").Item(1)
    Set ccK = ActiveDocument.SelectContentControlsByTag("код исполнителя").Item(1)
     
    Select Case ContentControl.Tag
    Case "исполнитель":
        SyncContentControlByValue ccI, ccK
    Case "код исполнителя":
        SyncContentControlByValue ccK, ccI
    End Select
End Sub 

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    Dim ccI As ContentControl 'переменная цикла перебора элементов управления
    Dim ccS As ContentControl 'Генератор события
    Dim sControlText As String 'Текст, выбранный в генераторе события
    Dim i As Integer
    
    Set ccS = ContentControl
    sControlText = ccS.Range.Text
    
    For Each ccI In ActiveDocument.ContentControls
        'If ccI.Type = wdContentControlDropdownList Then 'Отсеиваем не списки
            If ccI.ID <> ContentControl.ID Then 'Отсеиваем генератор события
                'Цикл ищет индекс выбранного элемента списка
                For i = 1 To ccS.DropdownListEntries.Count
                    If sControlText = ccS.DropdownListEntries.Item(i).Text Then
                        'Выбираем соответсвующий пункт в других списках
                        ccI.DropdownListEntries.Item(i).Select
                    End If
                Next
            End If
        'End If
    Next
End Sub