none
Copy Multiple Ranges from Excel and Paste into Word RRS feed

  • Question

  • I'm trying to run the code below and I'm getting some weird behavior.  It seems like it works about 10% of the time, and about 90% of the time it fails on this one line.

    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)

    Sub Export_Table_Word()
    
        'Name of the existing Word doc.
        Const stWordReport As String = "Final Report.docx"
        
        'Word objects.
        Dim wdApp As Word.Application
        Dim wdDoc As Word.Document
        Dim wdbmRange1 As Word.Range
        Dim wdbmRange2 As Word.Range
        
        'Excel objects.
        Dim wbBook As Workbook
        Dim wsSheet1 As Worksheet
        Dim wsSheet2 As Worksheet
        Dim rnReport1 As Range
        Dim rnReport2 As Range
        
        'Initialize the Excel objects.
        Set wbBook = ThisWorkbook
        Set wsSheet1 = wbBook.Worksheets("Contact Information1")
        Set rnReport1 = wsSheet1.Range("Table1")
        Set wsSheet2 = wbBook.Worksheets("Contact Information2")
        Set rnReport2 = wsSheet2.Range("Table2")
        
        'Initialize the Word objets.
        Set wdApp = New Word.Application
        Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
        Set wdbmRange1 = wdDoc.Bookmarks("Report1").Range
        Set wdbmRange2 = wdDoc.Bookmarks("Report2").Range
        
    
        Dim tbl As Table
        For Each tbl In wdDoc.Tables
            tbl.Delete
        Next tbl
    
    
        'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
        On Error Resume Next
        With wdDoc.InlineShapes(1)
            .Select
            .Delete
        End With
        On Error GoTo 0
        
        'Turn off screen updating.
        Application.ScreenUpdating = False
        
        'Copy the report to the clipboard.
        rnReport1.Copy
        rnReport2.Copy
        
        'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
        With wdbmRange1
            .Select
            .Paste
        End With
        
        With wdbmRange2
            .Select
            .Paste
        End With
        
        'Save and close the Word doc.
        With wdDoc
            .Save
            .Close
        End With
        
        'Quit Word.
        wdApp.Quit
        
        'Null out your variables.
        Set wdbmRange1 = Nothing
        Set wdbmRange2 = Nothing
        Set wdDoc = Nothing
        Set wdApp = Nothing
        
        'Clear out the clipboard, and turn screen updating back on.
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
        End With
        
        MsgBox "The report has successfully been " & vbNewLine & _
               "transferred to " & stWordReport, vbInformation
    
    End Sub


    I'm trying to copy from two ranges in two Excel sheets and paste into two bookmarks in Word.  Ultimately, there will probably be several ranges that I need to copy from Excel and paste into word.  Does anyone here have any idea why this is only working only sporadically. 

    Thanks!


    MY BOOK

    Friday, July 15, 2016 8:49 PM

Answers

  • I cam up with the script below.  This does what I want.

    Sub Export_Table_Word()
    
        'Name of the existing Word doc.
        'Const stWordReport As String = "Final Report.docx"
        
        'Word objects.
        Dim WDApp As Word.Application
        Dim WDDoc As Word.Document
        Dim wdbmRange1 As Word.Range
        
        'Excel objects.
        Dim wbBook As Workbook
        Dim wsSheet1 As Worksheet
        Dim rnReport1 As Range
        
        'Initialize the Excel objects.
        Set wbBook = ThisWorkbook
        Set WDApp = New Word.Application
        'Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
        Set WDDoc = WDApp.Documents.Open("C:\Users\rshuell001\Desktop\Final Report.docx")
        
            'Delete old fields and prepare to replace with new
            Dim doc As Document
            Dim fld As Field
            Set doc = WDDoc
            For Each fld In doc.Fields
              fld.Select
              If fld.Type = 88 Then
                fld.Delete
              End If
            Next
    
        Set wsSheet = wbBook.Worksheets("Contact Information1")
        Set rnReport = wsSheet.Range("BkMark1")
        Set wdbmRange = WDDoc.Bookmarks("BkMark1").Range
    
        'Turn off screen updating.
        Application.ScreenUpdating = False
        'Copy the report to the clipboard.
        rnReport.Copy
        'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
        With wdbmRange
            .Select
            .Paste
        End With
        WDDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
        
        
        Set wsSheet = wbBook.Worksheets("Contact Information2")
        Set rnReport = wsSheet.Range("BkMark2")
        Set wdbmRange = WDDoc.Bookmarks("BkMark2").Range
        Application.ScreenUpdating = False
        rnReport.Copy
        With wdbmRange
            .Select
            .Paste
        End With
        WDDoc.Tables(2).AutoFitBehavior wdAutoFitWindow
        
        
        Set wsSheet = wbBook.Worksheets("Contact Information3")
        Set rnReport = wsSheet.Range("BkMark3")
        Set wdbmRange = WDDoc.Bookmarks("BkMark3").Range
        Application.ScreenUpdating = False
        rnReport.Copy
        With wdbmRange
            .Select
            .Paste
        End With
        WDDoc.Tables(3).AutoFitBehavior wdAutoFitWindow
        
        
        'Save and close the Word doc.
        With WDDoc
            .Save
            .Close
        End With
        
        'Quit Word.
        WDApp.Quit
        
        'Null out your variables.
        Set fld = Nothing
        Set doc = Nothing
        Set wdbmRange = Nothing
        Set WDDoc = Nothing
        Set WDApp = Nothing
        
        'Clear out the clipboard, and turn screen updating back on.
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
        End With
        
        MsgBox "The report has successfully been " & vbNewLine & _
               "transferred to " & stWordReport, vbInformation
    
    End Sub
    


    MY BOOK

    Tuesday, July 19, 2016 4:24 AM

All replies

  • Hi ryguy72,

    you had mentioned that 90 % time it get failed.

    did you got any error when it failed?

    can you tell us what is the value available for a path when it get fail.

    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)

    if we see the line of code then we can notice that you are trying to open a word document.

    you had used wbBook.Path. wbBook is object of Active workbook.

    it means that the word file also stored in the same folder.

    did you try to pass the path manually ? did it also got failed?

    please check it.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, July 18, 2016 5:34 AM
    Moderator
  • Thanks.  I played with it more and got the script below to work.

    Sub Export_Table_Word()
    
        'Name of the existing Word doc.
        Const stWordReport As String = "Final Report.docx"
        
        'Word objects.
        Dim wdApp As Word.Application
        Dim wdDoc As Word.Document
        Dim wdbmRange1 As Word.Range
        
        'Excel objects.
        Dim wbBook As Workbook
        Dim wsSheet1 As Worksheet
        Dim rnReport1 As Range
        
        'Initialize the Excel objects.
        Set wbBook = ThisWorkbook
        Set wdApp = New Word.Application
        Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
        
        Set wsSheet1 = wbBook.Worksheets("Contact Information1")
        Set rnReport1 = wsSheet1.Range("BkMark1")
        Set wdbmRange1 = wdDoc.Bookmarks("BkMark1").Range
    
        Dim tbl As Table
        For Each tbl In wdDoc.Tables
            tbl.Delete
        Next tbl
    
        'Turn off screen updating.
        Application.ScreenUpdating = False
        
        'Copy the report to the clipboard.
        rnReport1.Copy
        
        'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
        With wdbmRange1
            .Select
            .Paste
        End With
        
        wdDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
        
        'Save and close the Word doc.
        With wdDoc
            .Save
            .Close
        End With
        
        'Quit Word.
        wdApp.Quit
        
        'Null out your variables.
        Set wdbmRange1 = Nothing
        Set wdDoc = Nothing
        Set wdApp = Nothing
        
        'Clear out the clipboard, and turn screen updating back on.
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
        End With
        
        MsgBox "The report has successfully been " & vbNewLine & _
               "transferred to " & stWordReport, vbInformation
    
    End Sub
    
    

    The thing is, this is for one Range and one Bookmark.  I want to set this up to run over several Ranges and several Bookmarks.  Is that easy to do?  Finally, it seems like the Bookmarks in Word seem to get deleted.  It's somewhat inconsistent, which doesn't make any sense.


    MY BOOK

    Monday, July 18, 2016 7:18 PM
  • I cam up with the script below.  This does what I want.

    Sub Export_Table_Word()
    
        'Name of the existing Word doc.
        'Const stWordReport As String = "Final Report.docx"
        
        'Word objects.
        Dim WDApp As Word.Application
        Dim WDDoc As Word.Document
        Dim wdbmRange1 As Word.Range
        
        'Excel objects.
        Dim wbBook As Workbook
        Dim wsSheet1 As Worksheet
        Dim rnReport1 As Range
        
        'Initialize the Excel objects.
        Set wbBook = ThisWorkbook
        Set WDApp = New Word.Application
        'Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
        Set WDDoc = WDApp.Documents.Open("C:\Users\rshuell001\Desktop\Final Report.docx")
        
            'Delete old fields and prepare to replace with new
            Dim doc As Document
            Dim fld As Field
            Set doc = WDDoc
            For Each fld In doc.Fields
              fld.Select
              If fld.Type = 88 Then
                fld.Delete
              End If
            Next
    
        Set wsSheet = wbBook.Worksheets("Contact Information1")
        Set rnReport = wsSheet.Range("BkMark1")
        Set wdbmRange = WDDoc.Bookmarks("BkMark1").Range
    
        'Turn off screen updating.
        Application.ScreenUpdating = False
        'Copy the report to the clipboard.
        rnReport.Copy
        'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
        With wdbmRange
            .Select
            .Paste
        End With
        WDDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
        
        
        Set wsSheet = wbBook.Worksheets("Contact Information2")
        Set rnReport = wsSheet.Range("BkMark2")
        Set wdbmRange = WDDoc.Bookmarks("BkMark2").Range
        Application.ScreenUpdating = False
        rnReport.Copy
        With wdbmRange
            .Select
            .Paste
        End With
        WDDoc.Tables(2).AutoFitBehavior wdAutoFitWindow
        
        
        Set wsSheet = wbBook.Worksheets("Contact Information3")
        Set rnReport = wsSheet.Range("BkMark3")
        Set wdbmRange = WDDoc.Bookmarks("BkMark3").Range
        Application.ScreenUpdating = False
        rnReport.Copy
        With wdbmRange
            .Select
            .Paste
        End With
        WDDoc.Tables(3).AutoFitBehavior wdAutoFitWindow
        
        
        'Save and close the Word doc.
        With WDDoc
            .Save
            .Close
        End With
        
        'Quit Word.
        WDApp.Quit
        
        'Null out your variables.
        Set fld = Nothing
        Set doc = Nothing
        Set wdbmRange = Nothing
        Set WDDoc = Nothing
        Set WDApp = Nothing
        
        'Clear out the clipboard, and turn screen updating back on.
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
        End With
        
        MsgBox "The report has successfully been " & vbNewLine & _
               "transferred to " & stWordReport, vbInformation
    
    End Sub
    


    MY BOOK

    Tuesday, July 19, 2016 4:24 AM