Copy Excel Sheet into Word via Visual Basic

Question

Hi,

I have a similar question to the one below, except that I would like to initiate the VB code from Excel - if possible.

Basically, I want to copy an entire Excel worksheet (named 'RA') from an workbook (that contains 4 sheets) into a Word document. The reason for this is that it will be easier for users to edit after my other VB-based edits are completed.

Following is the thread of the similar question - the one where the VB code is initiated via Word:

_____________________________________________________________________________________________________________________________

How to copy range of Excel (col A:G ) till last row into MS word by MS word VBA

Hi guys i need advice on VBA ( ms word )

Let me explain what i am trying to do is that , firstly i have done a userform in MS words. In one of my frame there is this label, when the user clicks on it , it will put data from textbox1 to Excel workbook named "book1.xlsx" and split the words by " ; " . This is done because the text box has multple value in a string which paste into a cell of excel which then split into words to row of cells in column A . Resulting like a normal table with datas in excel.

right now what i need help is that i would like to copy down to the last row of data ( column A to G ) and paste the rage of data into my words by DataType:=wdPasteOLEObjecton to a book mark call "excel table"


Found this helpful 0

Answer

rich007a replied on

Try this:

Sub fda()

    Dim wdRng As Range

    Dim xl As Excel.Application

    Dim xlWb As Excel.Workbook

    Dim xlWs As Excel.Worksheet

    Dim xlRng As Excel.Range

    Set xl = GetObject(, "Excel.Application")

    Set xlWb = xl.Workbooks.Add

    Set xlWs = xlWb.Worksheets(1)

'Just filling with some data for this example:    xlWs.Range("A1:G10").Value = "testing"

    Set xlRng = xlWs.Range("A1", xlWs.Range("G" & xlWs.Rows.Count).End(xlUp))

    xlRng.Copy

    Set wdRng = ActiveDocument.Bookmarks("MyBookmark").Range

    wdRng.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _

        Placement:=wdInLine, DisplayAsIcon:=False

    Set xl = Nothing

End Sub

This will copy to the last populated row in column G.

Hope that helps.

Cheers

Rich

_____________________________________________________________________________________________________________________________

Please note that my contract is ending this Monday, March 31st, so I appreciate ANY replies. I will attempt to find some one to take my place as the point of contact for this thread.

Thanks in advance,

Mary

Answer 1

The code in question merely reverses the code from rich007a so that it will run from Excel rather than Word. I had assumed that you knew enough Excel VBA to tailor it to your needs.

It fills a range in an empty worksheet with 'testing' and then pastes that content to a Word document. If you want to copy the whole of an existing worksheet into Word, then you need to remove the code that fills the worksheet e.g.

Sub CopyToWord()

Dim wdApp As Object

Dim wdDoc As Object

Dim wdRng As Object

Dim xlWs As Excel.Worksheet

Dim xlRng As Excel.Range

Dim LastRow As Long

Dim LastCol As Long

    On Error Resume Next

    Set wdApp = GetObject(, "Word.Application")

    If Err Then

        Set wdApp = CreateObject("Word.Application")

    End If

    On Error GoTo 0

    Set wdDoc = wdApp.Documents.Add(Visible:=True)

    wdDoc.PageSetup.Orientation = 1 'landscape

    Set xlWs = ActiveSheet

    LastCol = xlWs.Cells(1, xlWs.Columns.Count).End(xlToLeft).Column

    LastRow = xlWs.Range("A" & xlWs.Rows.Count).End(xlUp).Row

    Set xlRng = xlWs.Range("A1", xlWs.Cells(LastRow, LastCol))

    xlRng.Copy

    Set wdRng = wdDoc.Range

    wdRng.PasteSpecial Link:=False, _

                       DataType:=0, _

                       Placement:=0, _

                       DisplayAsIcon:=False

    Set wdApp = Nothing

    Set wdDoc = Nothing

    Set wdRng = Nothing

    Set xlWs = Nothing

    Set xlRng = Nothing

End Sub

However, and this is a very big 'however', you are trying to paste a huge worksheet into a Word document and display it there. There is no way that is going to work (as you will see when you try it).  You will get a tiny view and much of the sheet will be off the page.

The only way that you can copy such a large worksheet into a Word document would be to copy it in sections wide enough to fit on a page, either in Word landscape or portrait mode., and how big those sections need to be will be determined by what is in the Worksheet. If you tell me how many columns will fit on a Word page in either of those modes, I will tell you what extra is required to achieve this.

Also depending on what is in the worksheet and what the final aim is supposed to be, copying and pasting may not be the best approach. Directly transferring the content might be more appropriate.

If however you just want a link to the worksheet in a Word document, then that might be a more sensible approach. Change the two bold items i.e. 1 to 0 and False to True and that will store the worksheet with the document and put a link on the page.

Answer 2

Hi Graham,

Following is the prompt that appears:

Kind regards,

Mary

Answer 3

Thanks very much, Graham.

I replaced G with AP, because AP is the last column.

Unfortunately, I ended up with a sheet containing the following:

Newly inserted range A1:AP10 - each cell contains the text 'testing'

Also, the range A1:G78 is set to be copied (via the dotted moving line)

Finally, I am directed to "Select destination and press Enter or choose Paste'.

Aside from the fact that the incorrect range is selected (I assume that the 'testing' text code can be removed), I attempted to select a blank Word document, but this did not satisfy the code.

Kind regards,

Mary

Answer 4

The Excel equivalent of the Word macro would be as follows, however this creates a new document to take the table.

Sub CopyToWord()

Dim wdApp As Object

Dim wdDoc As Object

Dim wdRng As Object

Dim xlWs As Excel.Worksheet

Dim xlRng As Excel.Range

Dim LastRow As Long

    On Error Resume Next

    Set wdApp = GetObject(, "Word.Application")

    If Err Then

        Set wdApp = CreateObject("Word.Application")

    End If

    On Error GoTo 0

    Set wdDoc = wdApp.Documents.Add

    Set xlWs = ActiveSheet

    'Just filling with some data for this example:

    xlWs.Range("A1:G10").Value = "testing"

    Set xlRng = xlWs.Range("A1", xlWs.Range("G" & xlWs.Rows.Count).End(xlUp))

    xlRng.Copy

    Set wdRng = wdDoc.Range

    wdRng.PasteSpecial Link:=False, _

                       DataType:=0, _

                       Placement:=0, _

                       DisplayAsIcon:=False

    Set wdApp = Nothing

    Set wdDoc = Nothing

    Set wdRng = Nothing

    Set xlWs = Nothing

    Set xlRng = Nothing

End Sub