CODEWITHSUNDEEP
vbaexcel
user4946547
user4946547

Reputation:

Copy and paste on new page

I am trying to write a code that copies the contents of multiple worksheets in a single workbook into a single word document. I want the content of each worksheet to be on its own page, but right now, my code is just copying and pasting over each other instead of going onto a new page and pasting. I've tried going to the end of the document but it isn't working... Any advice would be helpful.

 Sub ToWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
Dim strdocname As String
'file name & folder path
On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
    Err.Clear
    'create new instance of word application
    Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "C:\Doc.doc"
If Dir(strdocname) = "" Then
    MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Doc.doc", vbExclamation, "The document does not exist "
    Exit Sub
End If

wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)

'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste

Next ws

'Clean up
Set wddoc = Nothing
Set wdapp = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Upvotes: 0

Views: 1809

Answers (2)

OpiesDad
OpiesDad

Reputation: 3435

EDIT

First, I incorrectly assumed the "wddoc.range" property would get wherever the cursor is. This is not true. You need to use the code provided by Miss Palmer (and replicated below).

However, there is an additional issue I didn't notice at first. Your loop is set incorrectly. You are looping through and continually reopening the word doc. You need to move these lines:

For Each ws In ActiveWorkbook.Worksheets
    ws.Range("A1:A2").Copy

so that they are immediately above the wddoc.Range(wddoc.Characters.Count - 1).Paste

line. This will cause the loop to be executed properly and only open the word doc once.

Also (again, per Miss Palmer), you want to put this:

wddoc.Range(wddoc.Characters.Count - 1).Paste
wddoc.Range(wddoc.Characters.Count - 1).InsertBreak (wdPageBreak)after the line:

instead of the ".range.paste" that you originially had.

The other issue with your "Selection" line is that you did not specify the application you wanted to use. This was using Excel's selection by default as it was being run from Excel.

This code assumes that you have a word document that doesn't have enough pages. Otherwise you could likely use the code you want, but it's unclear why you would have a blank word document with many pages. You'd still need to specify the app you want to move to the next page in, so put "wdapp." before the selection line.

http://word.tips.net/T000120_Jumping_to_the_Start_or_End_of_a_Document.html

Upvotes: 0

tea_pea
tea_pea

Reputation: 1542

you can just use:

wddoc.Range(i).Paste

incrementing i by 1 after each image. that pastes them one after another.

or more simply:

wddoc.Range(wddoc.Characters.Count-1).Paste

then could get more complicated and add a page break manually in between each if images are small to ensure a new page for each:

wddoc.Range(wddoc.Characters.Count-1).InsertBreak Type:=7

https://msdn.microsoft.com/en-us/library/office/ff821608.aspx

Upvotes: 2

Related Questions