Microsoft Office Forums - View Single Post - [Solved] How to transfer multiple cells from excel to word by formulas

Bird_FAT · 05-23-2009, 02:33 AM

OK - Here goes,

I'm hoping that I have understood you this time, and that this is what you want - if not, then you will have a little tweaking to do!

The following code should do the following when run:

go to the last cell in column A
Take the information and hold it in memory
repeat the process for the other three (B,C,E) columns
Open your Word Template as a document
Paste the information in memory to specified points in the document
leave the document open for any additional editing needed

to set it up you will need to do the following:

EXCEL:

Open the VBA window (Alt+F11)
Double-click on 'This Worksheet' (in the left-hand explorer window) to open the code page
Paste the code from below
Click on 'Tools > References > tick Microsoft Word xx.x Object Library (xx.x is a number) > OK'

WORD:

In your document you will need to insert bookmarks into the places where you want the information to go - I will explain where to change the code to fit these.
Save the Document as a NORMAL file (NOT as a template) - you will need the full path details for this file.

VBA:

Once the code is in place, you will need to edit the information in the code to fit your situation - look at the green lines below for explanation.

Code:

Option Explicit

Sub ExportFinalColumnToWord()
    On Error GoTo errorHandler

    Dim wdApp As Word.Application
    Dim myDoc As Word.Document
    Dim mywdRange As Word.Range
    
    Dim MyColumnA As Excel.Range
    Dim MyColumnB As Excel.Range
    Dim MyColumnC As Excel.Range
    Dim MyColumnE As Excel.Range

    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err.Number <> 0 Then
            Set wdApp = CreateObject("Word.Application")
        End If
    On Error GoTo 0

' You need to change the path details here -
' This will create a new document based on your original.
    Set myDoc = wdApp.Documents.Add(Template:="C:\Tempo\ExWd.doc")

' Here you need to change the following:
' MySheet - this is the tab name of the sheet in the spreadsheet
' A1,B1,C1,E1 - these are the columns where the data is found
    Set MyColumnA = Sheets("MySheet").Range("A1").End(xlDown)
    Set MyColumnB = Sheets("MySheet").Range("B1").End(xlDown)
    Set MyColumnC = Sheets("MySheet").Range("C1").End(xlDown)
    Set MyColumnE = Sheets("MySheet").Range("E1").End(xlDown)


' This is where you get the information pasted into your document.
' Below there are four references to bookmarks - inside the ("").
' You will need to change the names to those of YOUR bookmarks.
' If you want data entered into more than one place, you need to
' create a new line, as below, and change the bookmark name,
' choosing the correct reference at the end 'MyColumnX'
' For example to have the information from Column A in another place,
' you would add the line in green that is below this section.
        With myDoc.Bookmarks
            .Item("bmMyColumnA").Range.InsertAfter MyColumnA
            .Item("bmMyColumnB").Range.InsertAfter MyColumnB
            .Item("bmMyColumnC").Range.InsertAfter MyColumnC
            .Item("bmMyColumnE").Range.InsertAfter MyColumnE
'           .Item("bmMyColumnA_2").Range.InsertAfter MyColumnA
        End With

' At this point the Word Application will appear in your taskbar
    wdApp.Visible = True
    Exit Sub

errorHandler:
    wdApp.Quit
    Set wdApp = Nothing
    Set myDoc = Nothing
    Set mywdRange = Nothing

End Sub

If you then place a new macro button on your taskbar, you could link it to the macro and run it whenever you want it.

Hope that does the job!