Copy entire worksheet contents into already open Word document - excel

Question

I have two partial working bits of code to put together.
I have a worksheet labeled 'word' that I want to export and save automatically under a variable.
Sub CreateNewWordDoc()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
docname = Worksheets("input").Range("b10").Value
Data1 = Worksheets("word").Range("a1:d103").Value
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Results\ResultsTemplate.doc")
'******THIS IS TO EDIT THE WORD DOCUMENT******
With Worksheets("word")
CopyRangeToWord wdDoc, .Range("A1:d104")
'******THIS IS THE END TO EDIT THE WORD DOCUMENT*****
If Dir("C:\Results\" & docname & ".doc") <> "" Then
Kill "C:\Results\" & docname & ".doc"
End If
.SaveAs ("C:\Results\" & docname & ".doc")
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
I like this first one the best. It will open my template that has all the official stuff that these generated reports will require (company info etc) and will automatically save and close with the correct file name. However, I cannot find a way to get it to copy all the information from the worksheet 'word' into the text body of the document. It is saving a blank document.
While troubleshooting, I came across this code:
Private Sub CopyRangeToWord(ByRef wdDoc As Word.Document, rng_to_copy As Range, Optional page_break As Boolean = True)
' Will copy the range given into the word document given.
Application.StatusBar = "Copying data from " & rng_to_copy.Parent.Name & "..."
rng_to_copy.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
' insert page break after all worksheets except the last one
If page_break Then
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End Sub
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
docname = Worksheets("input").Range("b10").Value
With Worksheets("word")
CopyRangeToWord wdDoc, .Range("A1:d104")
End With
Set ws = Nothing
Application.StatusBar = "Cleaning up..."
'apply normal view
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
which does the exact opposite of the first code: it will open up a new document (not the template), will copy all the data perfectly but will not save or close with correct filenames.
I am guessing that it will be easier to update code section one to copy the worksheet contents, and is what I would prefer.

Answer 1

Private Sub CopyRangeToWord(ByRef wdDoc As Word.Document, rng_to_copy As Range, Optional page_break As Boolean = True)
' Will copy the range given into the word document given.
Application.StatusBar = "Copying data from " & rng_to_copy.Parent.Name & "..."
rng_to_copy.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
' insert page break after all worksheets except the last one
If page_break Then
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End Sub
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
docname = Worksheets("input").Range("b10").Value
With Worksheets("word")
CopyRangeToWord wdDoc, .Range("A1:d104")
With wdDoc
.SaveAs ("C:\Results\" & docname & ".doc")
.Close
End With
End With
End Sub
this works: but does not open from my template. nonetheless - it will create a document from one worksheet and automatically save it to the directory with the filename referenced in a defined cell.