'Get the embedded data

arrLabs = fcnGetEmbeddedLabData(oDoc)
'Set the target worksheet

Set oSheet = Worksheets("Labs")
'Get target range (last row)

lngLastRow = oSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Write the extracted values

oSheet.Cells(lngLastRow, "A").Resize(1, UBound(arrLabs) + 1).Value = arrLabs
'...
'More code to close the Word doc and process next doc.


Function fcnGetEmbeddedLabData(oDocPassed As Object) As String()
'Returns values in last column of embedded worksheet to a array.

Dim oILS As InlineShape
Dim oWS As Worksheet
Dim oWB As Workbook
Dim lngRow As Long, lngCol As Long
Dim lngRows As Long
Dim arrData() As String
  ReDim arrData(287)
  For Each oILS In oDocPassed.InlineShapes
    If oILS.Type = wdInlineShapeEmbeddedOLEObject Then
      If oILS.OLEFormat.progID = "Excel.Sheet.12" Then
        oILS.OLEFormat.Edit
        Set oWB = Workbooks(2)
        Set oWS = oWB.Sheets(1)
        lngCol = oWS.Cells(2, oWS.Columns.Count).End(xlToLeft).Column
        lngRows = oWS.Cells(Rows.Count, "A").End(xlUp).Row
        arrData(0) = oDocPassed.SelectContentControlsByTitle(strCCUnique).Item(1).Range.Text
        For lngRow = 1 To lngRows
          Select Case oWS.Cells(lngRow, lngCol).Text
            Case Is = "#DIV/0!", "#NUM!", "#VALUE!"
            Case Else
              arrData(lngRow) = oWS.Cells(lngRow, lngCol).Text
          End Select
        Next lngRow
      End If
    End If
  Next oILS
  fcnGetEmbeddedLabData = arrData()
  
lbl_Exit:
  Set oWB = Nothing: Set oWS = Nothing
  Exit Function
End Function