Sub GetExcelData()
Application.ScreenUpdating = False
'Note: A VBA Reference to the Excel Object Model is required, via Tools|References
Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook, xlWkSht As Excel.Worksheet
Dim StrWkBkNm As String, i As Long, j As Long, r As Long, x As Long
StrWkBkNm = ThisDocument.Path & "\Data to fill.xlsx"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
With xlApp
  .Visible = False
  .DisplayAlerts = False
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMRU:=False)
End With
Set xlWkSht = xlWkBk.Worksheets("Sheet1")
With ActiveDocument
  For i = 1 To .Tables.Count
    r = i + 1: x = 0
    With .Tables(i)
      With .Range
        .Find.Execute FindText:="<PV:>", MatchWildcards:=True, Wrap:=wdFindStop
        If .Find.Found = True Then x = .Range.Cells(1).RowIndex
      End With
      If x > 0 Then
        .Cell(x, 2).Range.Text = "PV: " & xlWkSht.Range("B" & r).Value
        With .Cell(x + 1, 2).Range
          .ContentControls(1).Checked = (xlWkSht.Range("F" & r).Value = "Y")
          .ContentControls(2).Checked = (xlWkSht.Range("F" & r).Value = "Y")
          .ContentControls(3).Checked = (xlWkSht.Range("G" & r).Value = "Y")
        End With
        With .Cell(x + 1, 1).Range
          With .ContentControls(1)
            .Type = wdContentControlText
            .Range.Text = xlWkSht.Range("A" & r).Value
            .Type = wdContentControlDropdownList
          End With
          With .ContentControls(2)
            .Type = wdContentControlText
            .Range.Text = xlWkSht.Range("D" & r).Value
            .Type = wdContentControlDropdownList
          End With
          With .ContentControls(3)
            .Type = wdContentControlText
            .Range.Text = xlWkSht.Range("C" & r).Value
            .Type = wdContentControlDropdownList
          End With
        End With
      End If
    End With
  Next
End With
xlWkBk.Close False
xlApp.Quit
Set xlWkSht = Nothing: Set xlWkBk = Nothing: Set xlApp = Nothing
Application.ScreenUpdating = True
End Sub