Print Excel To Word

[Rentapen]

For weeks I have been surfing and rearranging this file to print just the
current or called out active sheet.
This wants to do the entire book, any help?

just wandering
rentapen


Sub CopyWorksheetToWord()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim 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
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

 

[BrianB]

This is the bit that does it :-

For Each ws In ActiveWorkbook.Worksheets

so delete the line and the word Next below and instead put

Set ws = ActiveSheet

Regards
BrianB
===========================================

 

[Rentapen]

Thanks Brian, works like a charm.

rentapen

This is the bit that does it :-

For Each ws In ActiveWorkbook.Worksheets

so delete the line and the word Next below and instead put

Set ws = ActiveSheet

Regards
BrianB
===========================================




"Rentapen" <[email protected]> wrote in message