#1
|
|||
|
|||
VBA to paste from excel onto 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! I'm not sure if I posted into the right place, because this is with VBA Excel.
Code:
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:\Name.doc" If Dir(strdocname) = "" Then MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Name.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 |
#2
|
||||
|
||||
You are actually posting in the Word forum, however the following should do the trick. You don't need to activate the document if working with ranges. The reason each sheet overwrote the previous is that you pasted to the document range, rather than insert a page and paste to that.
Code:
Option Explicit Sub toWord() Dim ws As Worksheet Dim Wkbk1 As Workbook Dim wdapp As Object Dim wddoc As Object Dim orng As Object Dim strdocname As String Set Wkbk1 = ActiveWorkbook Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False strdocname = "C:\Name.doc" '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 If Dir(strdocname) = "" Then 'MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Path\Name.doc", _ ' vbExclamation, "The document does not exist " 'Exit Sub Set wddoc = wdapp.Documents.Add Else Set wddoc = wdapp.Documents.Open(strdocname) End If For Each ws In ActiveWorkbook.Worksheets ws.Range("A1:A2").Copy Set orng = wddoc.Range orng.collapse 0 orng.Paste orng.End = wddoc.Range.End orng.collapse 0 orng.insertbreak 7 Next ws lbl_Exit: Set orng = Nothing Set wddoc = Nothing Set wdapp = Nothing Set Wkbk1 = Nothing Set ws = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Page Up & Copy/Paste Issues | weamish | Word | 10 | 02-01-2014 08:25 PM |
Copy Paste each cell to a new page | Singh_Edm | Word | 12 | 01-20-2014 12:55 AM |
Paste special an Excel range into Outlook as an Excel Worksheet | charlesh3 | Excel Programming | 3 | 02-04-2013 04:33 PM |
Find, copy and paste into a new page | jperez84 | Word VBA | 24 | 09-20-2012 11:34 AM |
How to cut and paste a graphic to a different page in word.? | soooty | Drawing and Graphics | 1 | 08-12-2010 11:17 AM |