Copy worksheet information to Word

 1999-12-20    Import & Export    0    307

The macro below copies all worksheets in a workbook to a new Word document. Each worksheet starts on a new page in the Word document:

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
        If ws.Visible Then ' include only visible 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
        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