Excel VBA: Save workbook as Word document - vba

Question

I would like to save my workbook (all sheets) as one Word document.
One sheets it's one page in document.
I find only code for save activeSheet.
Sub ExcelToWord()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim objWd As Object
Set objWd = CreateObject("word.application")
objWd.Visible = True
Dim objDoc As Object
Set objDoc = objWd.Documents.Add
objDoc.PageSetup.Orientation = 1 ' portrait = 0
Application.ScreenUpdating = False
ws.UsedRange.Copy
objDoc.Content.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
objDoc.SaveAs (Application.ThisWorkbook.Path & "\dokument.docx")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Thanks for your reply.

Answer 1

A couple quick things will get you to a solution.
The first is to loop through the worksheets in your workbook, like this:
Dim ws As Worksheet
For Each ws in ThisWorkbook.Sheets
Debug.Print "The used range is " & ws.UsedRange.Address
Next ws
The next part is to understand how adding content to a Word document is accomplished. The main concept involves where the insertion point for the document is located -- generally this is the current Selection.
When you cut and paste into a Word document, the content just pasted is still "selected". This means that any subsequent paste will effectively replace what you just inserted. So you have to move the selection point to the end of the document.
Putting it all together in an example program:
Option Explicit
Public Sub ExcelToWord()
Dim wb As Workbook
Set wb = ThisWorkbook
'--- create the Word document
Dim objWd As Word.Application
Set objWd = CreateObject("word.application")
objWd.Visible = True
Dim objDoc As Word.Document
Set objDoc = objWd.Documents.Add
objDoc.PageSetup.Orientation = 1 ' portrait = 0
Const wdPageBreak As Long = 7
Dim ws As Worksheet
For Each ws In wb.Sheets
ws.UsedRange.Copy
objWd.Selection.Paste
'--- advance the selection point to the end of
' the document and insert a page break, then
' advance the insertion point past the break
objDoc.Characters.Last.Select
objWd.Selection.InsertBreak wdPageBreak
objDoc.Characters.Last.Select
Next ws
'objDoc.SaveAs Application.ThisWorkbook.Path & ".\dokument.docx"
End Sub