tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc

Sub aTest()
  Dim srcDoc As Document, tgtDoc As Document
  Dim srcTable As Table, tgtTable As Table
  Dim i As Integer, strTime As String, strDesc As String
  
  Set srcDoc = Documents("Test daily (1).docx")
  Set tgtDoc = Documents("Test www.docx")
  Set srcTable = srcDoc.Tables(1)
  Set tgtTable = tgtDoc.Tables(1)
  
  For i = 2 To srcTable.Rows.Count
    strTime = srcTable.Cell(i, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    strDesc = srcTable.Cell(i, 2).Range.Text
    strDesc = Left(strDesc, Len(strDesc) - 2)
    tgtTable.Cell(i, 1).Range.ContentControls(1).Range.Text = strTime
    tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
  Next
End Sub

Sub TestA()
'Graham Mayor
Dim srcDoc As Document, tgtDoc As Document
Dim srcTable As Table, tgtTable As Table
Dim i As Integer, strTime As String, strDesc As String
Dim oCell As Range
Dim strPath As String
    'Make sure the files still exist
    If Not FileExists("C:\Path\Test daily.docx") Then
        strPath = "C:\Path\Test daily.docx"
        GoTo err_handler
    End If
    If Not FileExists("C:\Path\Test_www.docx") Then
        strPath = "C:\Path\Test_www.docx"
        GoTo err_handler
    End If
    Set srcDoc = Documents.Open("C:\Path\Test daily.docx")
    Set tgtDoc = Documents.Open("C:\Path\Test_www.docx")
    Set srcTable = srcDoc.Tables(1)
    Set tgtTable = tgtDoc.Tables(1)
    'Ensure that target table has enough rows
    Do Until tgtTable.Rows.Count = srcTable.Rows.Count
        tgtTable.Rows.Add
    Loop
    For i = 2 To srcTable.Rows.Count
        Set oCell = srcTable.Cell(i, 1).Range
        'remove the cell end character from the range
        oCell.End = oCell.End - 1
        strTime = oCell.Text
        strTime = Left(strTime, Len(strTime) - 2)
        Set oCell = srcTable.Cell(i, 2).Range
        'remove the cell end character from the range
        oCell.End = oCell.End - 1
        strDesc = oCell.Text
        strDesc = Left(strDesc, Len(strDesc) - 2)
        'make sure the cell has a content control
        If tgtTable.Cell(i, 1).Range.ContentControls.Count > 0 Then
            tgtTable.Cell(i, 1).Range.ContentControls(1).Range.Text = strTime
        Else        'if not write to the cell directly
            tgtTable.Cell(i, 1).Range.Text = strTime
        End If
        If tgtTable.Cell(i, 5).Range.ContentControls.Count > 0 Then
            tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
        Else
            tgtTable.Cell(i, 5).Range.Text = strDesc
        End If
    Next i

lbl_Exit:            'clean up
    Set srcDoc = Nothing
    Set tgtDoc = Nothing
    Set srcTable = Nothing
    Set tgtTable = Nothing
    Set oCell = Nothing
    Exit Sub
err_handler:
    MsgBox "The document " & strPath & " is missing"
    GoTo lbl_Exit
End Sub

Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor
'strFullName is the name with path of the file to check
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(strFullName) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Exit Function
End Function

Sub Update_Wdp()

  Dim srcDoc As Document, tgtDoc As Document, Ddp As Document, Wdp As Document
  Dim srcTable As Table, tgtTable As Table, srcDate As Table, tgtDate As Table
  Dim i As Integer, J As Integer, strTime As String, strDesc As String
  

'Check to see if two documents are open, Ddp and Wdp
MsgBox ("Must have Ddp & Wdp open!" & vbNewLine & vbNewLine & "Ensure Ddp is selected, not Wdp!")
   If Documents.Count <> 2 Then
      MsgBox ("Must have Ddp & Wdp open!")
   End If
   
'Set word document #1 to Ddp and word document #2 to Wdp
Set Ddp = activeDocument

   If Ddp = Documents(1) Then
      Set Wdp = Documents(2)
   Else
      Set Wdp = Documents(1)
   End If

'Set Ddp as source and Wdp target
Ddp.Activate
  Set srcDoc = Ddp
  Set tgtDoc = Wdp
  Set srcTable = srcDoc.Tables(3)
  Set tgtTable = tgtDoc.Tables(3)
  Set srcDate = srcDoc.Tables(1)
  Set tgtDate = tgtDoc.Tables(1)
  
'Set Date and Clear contents in Wdp for Table 3 - Project Log and format
Wdp.Activate
Application.ScreenUpdating = False
  'Set Date
  tgtDate.Cell(1, 4).Range.contentControls(1).Range.Text = srcDate.Cell(2, 4).Range.Text
  'Clear contents in Wdp for Table 3 - Project Log and format
  For i = 2 To tgtTable.Rows.Count
    tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = "HH:MM"
    tgtTable.Cell(i, 1).Range.Font.Color = -603937025
    tgtTable.Cell(i, 2).Range.contentControls(1).Range.Text = "HH:MM"
    tgtTable.Cell(i, 2).Range.Font.Color = -603937025
    tgtTable.Cell(i, 5).Range.contentControls(1).Range.Text = "...."
    tgtTable.Cell(i, 5).Range.Font.Color = -603937025
  Next
    
'Update contents in Wdp (Table 3 - Project Log) based on Ddp (Table 3 - Time and Details of Activities)
  For i = 2 To srcTable.Rows.Count
    strTime = srcTable.Cell(i, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    strDesc = srcTable.Cell(i, 2).Range.Text
    strDesc = Left(strDesc, Len(strDesc) - 2)
    tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = strTime
    tgtTable.Cell(i, 5).Range.contentControls(1).Range.Text = strDesc
  Next
'Update contents in Wdp (Table 3 - Project Log) column 2
  For J = 3 To srcTable.Rows.Count
    strTime = srcTable.Cell(J, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    tgtTable.Cell((J - 1), 2).Range.contentControls(1).Range.Text = strTime
  Next J
'Update last time of the day 23:59 in Wdp (Table 3 - Project Log) column 2
  For i = 2 To tgtTable.Rows.Count
    If tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = "23:59" Then
      tgtTable.Cell(i, 2).Range.contentControls(1).Range.Text = "23:59"
    End If
  Next

Application.ScreenUpdating = True


MsgBox ("NOTE: Content Controls don't always accept the:" & vbNewLine & vbNewLine & Space(30) & "ENTER/Return key" & vbNewLine & vbNewLine & "Ensure all your text in the DdP is in ONE paragraph.")

End Sub