+ Reply to Thread
Results 1 to 2 of 2

Copy 1 worksheet page from Workbook to Word using VBA

Hybrid View

  1. #1
    Registered User
    Join Date
    07-02-2008
    Location
    tN
    Posts
    1

    Copy 1 worksheet page from Workbook to Word using VBA

    There is a posting on this website that has the code for copying an entire workbook (separated by pages per each work sheet). What would be the manipulations of the following code, to only copy the selected worksheet from the workbook to a word doc? Thanks!

    Sub CopyWorksheetsToWord()
    ' requires a reference to the Word Object library:
    ' in the VBE select Tools, References and check the Microsoft Word X.X object library
    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
    For Each ws In ActiveWorkbook.Worksheets
    Application.StatusBar = "Copying data from " & ws.Name & "..."
    ws.UsedRange.Copy ' or edit to the range you want to 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 Not ws.Name = Worksheets(Worksheets.Count).Name Then
    With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
    .InsertParagraphBefore
    .Collapse Direction:=wdCollapseEnd
    .InsertBreak Type:=wdPageBreak
    End With
    End If
    Next ws
    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

  2. #2
    Forum Contributor SOS's Avatar
    Join Date
    01-26-2004
    Location
    Glasgow, Scotland
    MS-Off Ver
    Excel 2003
    Posts
    327
    Hi jennsuprgrl,

    I just changed your code to take out the "For each ws in ActiveWorkBook" line because that was looping through all sheets and replaced it with
    Set ws = ActiveSheet and With ActiveSheet

    Sub CopyWorksheetsToWord()
    ' requires a reference to the Word Object library:
    ' in the VBE select Tools, References and check the Microsoft Word X.X object library
    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
    Set ws = ActiveSheet
        With ActiveSheet
           Application.StatusBar = "Copying data from " & ws.Name & "..."
                ws.UsedRange.Copy ' or edit to the range you want to 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 Not ws.Name = Worksheets(Worksheets.Count).Name Then
        With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
            .InsertParagraphBefore
            .Collapse Direction:=wdCollapseEnd
            .InsertBreak Type:=wdPageBreak
        End With
    End If
    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
    Hope this helps

    Seamus

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1