Option Explicit
#If VBA7 Then
  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
  Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub UpdateNewBook()
Dim oILS As InlineShape
Dim oApp As Excel.Application
Dim lngIndex As Long
Dim lngRow As Long, lngCol As Long, lngPause As Long
Dim varUR
Dim oRng As Excel.Range
Dim oDoc1 As Document
Dim oDoc2 As Document
  'Define the source and target documents.
  'The two documents are open.  The source document is the active document.
  If Documents(1).Name = "Target.docm" Then
    Set oDoc2 = Documents(1)
  Else
    Set oDoc2 = Documents(2)
  End If
  Set oDoc1 = ActiveDocument
  Set oILS = oDoc1.InlineShapes(1)
  On Error GoTo Err_Handler
  'Write the row heading column and column data to a array.
  With oILS
    .OLEFormat.DoVerb wdOLEVerbHide
    'Launch Excel
    Set oApp = .OLEFormat.Object.Application
    With oApp
      varUR = .Workbooks(1).Worksheets(1).UsedRange.Value
      'Close Excel
      .Quit
    End With
  End With
  'Kill some time
  Sleep 500
  Set oILS = Nothing: Set oApp = Nothing
  DoEvents
  Sleep 500
  DoEvents
  Set oILS = oDoc2.InlineShapes(1)
  With oILS
    'Kill some more time.
    For lngPause = 1 To 5
      DoEvents
      Sleep 100
      DoEvents
    Next lngPause
    .OLEFormat.DoVerb wdOLEVerbHide
    'Kill some more time
    For lngPause = 1 To 5
      DoEvents
      Sleep 100
      DoEvents
    Next lngPause
    Set oApp = .OLEFormat.Object.Application
    With oApp
      Set oRng = .Workbooks(1).Worksheets(1).Columns(1)
      For lngIndex = 1 To UBound(varUR)
        On Error Resume Next
        'Find the row heading in the target sheet that matches the row heading in the source sheet
        lngRow = .WorksheetFunction.Match(varUR(lngIndex, 1), oRng, 0)
        If Err.Number = 0 Then
          For lngCol = 2 To UBound(varUR, 2)
            'Write the values in the correct row
            .Workbooks(1).Worksheets(1).Cells(lngRow, lngCol).Value = varUR(lngIndex, lngCol)
          Next lngCol
        Else
          Err.Clear
        End If
      Next lngIndex
      .Workbooks(1).Save
      .Quit
    End With
  End With
lbl_Exit:
  Set oApp = Nothing
  Exit Sub
Err_Handler:
  If Not oApp Is Nothing Then
    oApp.Quit
  End If
  MsgBox Err.Number & " - " & Err.Description
End Sub