Without access to the workbook it's something of a step in the dark, but the following could work. As you know the worksheet name, you could set that for xlSheet instead of looping through all the sheets to find a sheet with two shapes.
Option Explicit
Sub Macro1()
Dim xlapp As Object
Dim xlbook As Object
Dim xlSheet As Object
Dim oShape As Object
Dim oWdShape As InlineShape
Dim oRng As Range
Const strSource As String = "C:\Path\Workbook.xlsx" 'the name of the workbook
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.workbooks.Open(strSource)
For Each xlSheet In xlbook.worksheets
If xlSheet.Shapes.Count = 2 Then
Set oShape = xlSheet.Shapes(1)
oShape.Copy
Set oRng = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
oRng.Collapse 1
oRng.PasteSpecial link:=False, _
DataType:=14, _
Placement:=wdInLine, _
DisplayAsIcon:=False
Set oRng = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
Set oWdShape = oRng.InlineShapes(1)
Set oShape = xlSheet.Shapes(2)
oShape.Copy
oRng.Start = oWdShape.Range.End + 1
oRng.Text = vbTab & vbTab
oRng.Collapse 0
oRng.PasteSpecial link:=False, _
DataType:=14, _
Placement:=wdInLine, _
DisplayAsIcon:=False
Exit For
End If
Next xlSheet
End Sub