Maybe this might be useful
Sub InsertExcelContentIntoWord() Dim wdApp As Object ' Word.Application Dim wdDoc As Object ' Word.Document Dim xlFilePath As String Dim objWord As Object Dim objDoc As Object ' Configuration xlFilePath = "C:\Path\To\Your\ClosedExcelFile.xlsx" ' <--CHANGE THIS TO YOUR EXCEL FILE PATH Const WORD_FILE_PATH As String = "C:\Path\To\Your\TargetWordDocument.docx" ' <-CHANGE THIS TO YOUR WORD FILE PATH Const INSERT_LOCATION As String = "EndOfDoc" ' Or specify a bookmark name like "MyBookmark" ' Error Handling On Error Resume Next Set wdApp = GetObject(, "Word.Application") On Error GoTo 0 ' Create Word Application if it's not running If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application") wdApp.Visible = True ' Optional: Make Word visible End If ' Open the Word Document On Error Resume Next Set wdDoc = wdApp.Documents(WORD_FILE_PATH) On Error GoTo 0 If wdDoc Is Nothing Then Set wdDoc = wdApp.Documents.Open(WORD_FILE_PATH) End If ' Determine the insertion range Dim objRange As Object Select Case UCase(INSERT_LOCATION) Case "ENDOFOOC" Set objRange = wdDoc.Content objRange.Collapse wdCollapse End Case Else ' Assume it's a bookmark name On Error Resume Next Set objRange = wdDoc.Bookmarks(INSERT_LOCATION).Range On Error GoTo 0 If objRange Is Nothing Then MsgBox "Bookmark '" & INSERT_LOCATION & "' not found in the Word document.", vbExclamation GoTo Cleanup End If End Select ' Insert Content as Linked Rich Text (for all sheets) Dim objExcel As Object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") On Error GoTo 0 If objExcel Is Nothing Then Set objExcel = CreateObject("Excel.Application") objExcel.Visible = False ' Keep Excel hidden End If Dim wb As Object On Error Resume Next Set wb = objExcel.Workbooks(xlFilePath) On Error GoTo 0 If wb Is Nothing Then Set wb = objExcel.Workbooks.Open(xlFilePath, ReadOnly:=True) End If Dim ws As Object For Each ws In wb.Sheets ' Insert the entire sheet as linked Rich Text objRange.InsertFile FileName:=xlFilePath, Range:=ws.Name, ConfirmConversions:=False, Link:=True, Attachment:=False objRange.Collapse wdCollapseEnd ' Move insertion point to the end objRange.InsertParagraphAfter ' Add a new line after each sheet Next ws ' Insert Content as Linked Excel Objects (for all charts and shapes) Dim objChart As Object Dim objShape As Object For Each ws In wb.Sheets For Each objChart In ws.ChartObjects objChart.Copy objRange.PasteSpecial Link:=True, DataType:=wdPasteOLEObject objRange.Collapse wdCollapseEnd objRange.InsertParagraphAfter Next objChart For Each objShape In ws.Shapes If objShape.Type <> msoEmbeddedOLEObject Then ' Avoid duplicating chart objects On Error Resume Next objShape.Copy If Err.Number = 0 Then objRange.PasteSpecial Link:=True, DataType:=wdPasteOLEObject objRange.Collapse wdCollapseEnd objRange.InsertParagraphAfter Else Err.Clear End If On Error GoTo 0 End If Next objShape Next ws ' Clean up Cleanup: If Not wb Is Nothing Then wb.Close SaveChanges:=False End If If objExcel Is Nothing Then ' If we created Excel, we might want to quit it (optional) ' objExcel.Quit End If Set wb = Nothing Set objExcel = Nothing Set objRange = Nothing Set wdDoc = Nothing ' Do NOT set wdApp to Nothing if Word was already open MsgBox "Content from '" & xlFilePath & "' inserted into '" & WORD_FILE_PATH & "' with links.", vbInformation End Sub




Reply With Quote