Export data from Excel to word

**delboy2405** · 01-13-2012, 10:05 AM

Hi,

I'm looking to convert the follow macro to instead of creating a new word document each time but to add each row to the same word document. I'm just starting to learn VBA and found the script on MRExcel site.

Sub ControlWord()
    Dim appWD As Word.Application
    ' Create a new instance of Word & make it visible
    Set appWD = CreateObject("Word.Application.14")
    appWD.Visible = True

    Sheets("data").Select
    'Find the last row with data in the database
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To FinalRow
        Sheets("Data").Select
        ' Copy the name to cell C4
        Range("A" & i).Copy Destination:=Sheets("Template").Range("C4")
        ' Copy data columns, transpose and paste in C10:C13
        Range("B" & i & ":E" & i).Copy
        Sheets("Template").Select
        Range("C10").PasteSpecial Transpose:=True
        ' Copy the data for the new document to the clipboard
        Range("A1:F15").Copy
        ' Tell Word to create a new document
        appWD.Documents.Add
        ' Tell Word to paste the contents of the clipboard into the new document
        appWD.Selection.Paste
        ' Save the new document with a sequential file name
        appWD.ActiveDocument.SaveAs Filename:="File" & i
        ' Close this new word document
        appWD.ActiveDocument.Close
    Next i
    ' Close the Word application
    appWD.Quit
End Sub

Am i thinking along the correct lines that i would need to create the word document first before the FOR loop and then add each to the word document in the Loop?

Any help would be appreciated.

**delboy2405** · 01-13-2012, 11:09 AM

Hi Managed to solve the issue myself, what i've noticed when running the macro is that it gets an error if a word document is already open. How would I get the macro to check for a word document and close it first

**snb** · 01-13-2012, 12:27 PM

Sub snb()
  Sheets("data").cells(1).currentregion.offset(1).copy
  with Getobject("E:\OF\example.docx")
    .paragraphs.last.range.paste
    .save
    .close -1
  end with
End Sub

**vthokie2010** · 01-13-2012, 12:58 PM

snb: I don't understand that code for resolving the question he had...I certainly could misunderstand it though. Here is the code I was thinking would solve the issue where it would close any instance of word that was open. I'm on word 2003

Sub CheckWord()

On Error Resume Next
    Word.Application.Quit
    If Err.Number = 429 Then
        Err.Clear
    Else
        MsgBox "unknown error occured"
    End If
On Error GoTo 0

End Sub

**delboy2405** · 01-13-2012, 02:54 PM

thanks vthokie2010

getting a different issue at the moment

When running the code below i'm getting error run time 4605 error code, i dont think i've changed anything since it was working ok, apart from putting the line

 WSR.Cells(1, 1).Font.Size = 14

But even when i comment out error appears, it also seems to happening randomly as it runs through the data on the loop

Full code

Sub ControlWord()

    Dim appWD As Word.Application
    ' Create a new instance of Word & make it visible
    Set appWD = CreateObject("Word.Application.14")
    appWD.Visible = True
    
    ' Tell Word to create a new document
    appWD.Documents.Add
    
     ' Add a new worksheet to this workbook
    Set WSR = Worksheets.Add(after:=Worksheets("Data"))

    ' Rename the new worksheet & set up titles
    WSR.Name = "Template"
    WSR.Cells(1, 1) = "Name"
    WSR.Cells(1, 1).Font.Size = 14
    WSR.Cells(2, 1) = "Posted"
    WSR.Cells(3, 1) = "Return Stamp"
    WSR.Cells(4, 1) = "Replied"
    WSR.Cells(5, 1) = "Attending"
    
    
    
    
    Sheets("data").Select
    'Find the last row with data in the database
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To FinalRow - 1
        Sheets("Data").Select
        ' Copy the name to cell C1
        Range("A" & i).Copy Destination:=Sheets("Template").Range("C1")
        ' Copy data columns, transpose and paste in C2:C5
        Range("B" & i & ":E" & i).Copy
        Sheets("Template").Select
        Range("C2").PasteSpecial Transpose:=True
        ' Copy the data for the new document to the clipboard
        WSR.Cells.Columns.AutoFit
        Range("A1:C6").Copy
      
        ' Tell Word to paste the contents of the clipboard into the new document
        appWD.Selection.Paste
        ' Save the new document with a sequential file name
      
    Next i
     
     appWD.ActiveDocument.SaveAs Filename:="File"
        ' Close this new word document
        appWD.ActiveDocument.Close
   
End Sub

**delboy2405** · 01-13-2012, 03:11 PM

Looks like it gets the error at line

  appWD.Selection.Paste

**vthokie2010** · 01-13-2012, 04:16 PM

Maybe try this in place of that line of code

appWD.activate
'might need to put a line of code that specifies the exact cell to paste to unless it is determined through a variable
Selection.Paste

if not let me know and I'll look at sometime over the weekend or monday.

**delboy2405** · 01-13-2012, 05:38 PM

unfortunately doesn't seem to work, when run code get an 438 error message.

**delboy2405** · 01-14-2012, 04:36 AM

looks like the issue has been solved, I went to tools > References and unticked word object library. Restarted Excel and then ticked again. Seems to be running fine now