how to copy and paste excel to word with word vba

Question

I want to insert the Excel file at the seartain BOOkmark in the Word doc without opening Excel, automatically inserted when the Word doc opens.

1.I'm thinking to make a pop up window with a open file dialog bottom firstly. And my code is following:(but it only work in excel VBA doesn't work in word VBA how should I change the code so that I can do it in word??? )

Sub openfile()
Dim intChoice As Integer
Dim strPath As String
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
End Sub

2. Then I made a copy and paste bottom the code is as follows:(It also only work when l code it in excel how to change to word vba?)

   Sub CopyWorksheetsToWord()
   Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet
   Application.ScreenUpdating = False
   Application.StatusBar = "Creating new document..."
   Set wdApp = New Word.Application
   Set wdDoc = wdApp.Documents.Add
   For Each ws In ActiveWorkbook.Worksheets
   
   ws.UsedRange.Copy
   wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
   wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
   Application.CutCopyMode = False
   wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
   If Not ws.Name = Worksheets(Worksheets.Count).Name Then
       With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
           .InsertParagraphBefore
           .Collapse Direction:=wdCollapseEnd
           .InsertBreak Type:=wdPageBreak
       End With
       End If
       Next ws
       Set ws = Nothing
       Application.StatusBar = "Cleaning up..."
       With wdApp.ActiveWindow
       If .View.SplitSpecial = wdPaneNone Then
       .ActivePane.View.Type = wdNormalView
        Else
       .View.Type = wdNormalView
       End If
       End With
       Set wdDoc = Nothing
       wdApp.Visible = True
       Set wdApp = Nothing
       Application.StatusBar = False
       End Sub
   

Answer 1

This should get you started. Place the code below in your Word document in the 'ThisDocument' module.

---

Add Excel reference to your Word VBA. In the VBA editor go to Tools and then References. Check the box next to Microsoft Excel 14.0 Object Library.

---

Private Sub Document_Open()
    Dim intChoice As Integer
    Dim strPath As String

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    intChoice = Application.FileDialog(msoFileDialogOpen).Show

    If intChoice <> 0 Then
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    End If

    CopyWorksheetsToWord (strPath)
End Sub


Function CopyWorksheetsToWord(filePath As String)
    Dim exApp As Excel.Application
    Dim exWbk As Excel.Workbook
    Dim exWks As Excel.Worksheet
    Dim wdDoc As Word.Document

    Application.ScreenUpdating = False
    Application.StatusBar = "Creating new document..."

    Set wdDoc = ActiveDocument
    Set exApp = New Excel.Application
    exApp.Visible = False

    Set exWbk = exApp.Workbooks.Open(filePath)

    For Each exWks In exWbk.Worksheets
        exWks.UsedRange.Copy
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
        exApp.CutCopyMode = False
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
        If Not exWks.Name = exWbk.Worksheets(exWbk.Worksheets.Count).Name Then
            With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                .InsertParagraphBefore
                .Collapse Direction:=wdCollapseEnd
                .InsertBreak Type:=wdPageBreak
            End With
        End If
    Next exWks

    Application.StatusBar = "Cleaning up..."

    Set exWks = Nothing
    exWbk.Close
    Set exWbk = Nothing
    Set exApp = Nothing

    Application.StatusBar = False
    Application.ScreenUpdating = True
End Function

---

1. Save file as macro-enabled file (.docm)
2. Close word file
3. Open word file and the code will run. First thing you'll see is a file open box to select the Excel file.

Tested code but there is no error checking.

---

Update per comment

Bookmarks can be located by name using the following syntax: wdDoc.Bookmarks("Bookmark2").Range

In this case I inserted a bookmark and labeled it Bookmark2

Updated Function Code:

Function CopyWorksheetsToWord(filePath As String)
    Dim exApp As Excel.Application
    Dim exWbk As Excel.Workbook
    Dim exWks As Excel.Worksheet
    Dim wdDoc As Word.Document
    Dim bmRange As Range

    Application.ScreenUpdating = False
    Application.StatusBar = "Creating new document..."

    Set wdDoc = ActiveDocument
    Set exApp = New Excel.Application
    exApp.Visible = False

    Set exWbk = exApp.Workbooks.Open(filePath)

    For Each exWks In exWbk.Worksheets
        exWks.UsedRange.Copy

        Set bmRange = wdDoc.Bookmarks("Bookmark2").Range
        bmRange.Paste

        exApp.CutCopyMode = False
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
        If Not exWks.Name = exWbk.Worksheets(exWbk.Worksheets.Count).Name Then
            With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                .InsertParagraphBefore
                .Collapse Direction:=wdCollapseEnd
                .InsertBreak Type:=wdPageBreak
            End With
        End If
    Next exWks

    Application.StatusBar = "Cleaning up..."

    Set exWks = Nothing
    exWbk.Close
    Set exWbk = Nothing
    Set exApp = Nothing

    Application.StatusBar = False
    Application.ScreenUpdating = True
End Function

Since your looping through sheets you'll probably need to play with formatting and how your stacking each section in the document but this should get you going.