View Single Post
 
Old 06-01-2015, 08:15 AM
VincentBrown VincentBrown is offline Windows 7 64bit Office 2013
Novice
 
Join Date: May 2015
Posts: 2
VincentBrown is on a distinguished road
Default 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
Reply With Quote