I have multiple Excel tabs that I would like to output into a word document. I was able to take some code (with help from the community of course!) and output the first tab of my excel to the word document. When I try to take the second tab on sheet 3 it just replaces the first page that I have created.
I have also tried another route of exporting each sheet as a separate word document and then merging them but that also ran into the same problem where the word just replaced the first page over and over.
Basically my code does the following:
- Creates a word file with specific margin outlines.
- Sets the table as a usedrange in the excel sheet. copies this
- Pastes into word.
Tries again for the next sheet. Runs into issues.
(Set tbl = ThisWorkbook.Worksheets(Sheet3.Name).UsedRange)
Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim WordTable As Word.Table
Dim MainDoc As Word.Document
Dim mydoct1 As Word.Document
Dim sFolderPath As String
Sub Export_to_Word()
Application.ScreenUpdating = False
Application.EnableEvents = False
'Create an Instance of MS Word
On Error Resume Next
'Is MS Word already opened?
Set WordApp = GetObject(class:="Word.Application")
'Clear the error between errors
Err.Clear
'If MS Word is not already open then open MS Word
If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
'Handle if the Word Application is not found
If Err.Number = 429 Then
MsgBox "Microsoft Word could not be found, aborting."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Create a New Document
Set mydoc1 = WordApp.Documents.Add
With mydoc1.PageSetup
.TopMargin = Application.CentimetersToPoints(1)
.BottomMargin = Application.CentimetersToPoints(1)
.LeftMargin = Application.CentimetersToPoints(1)
.RightMargin = Application.CentimetersToPoints(1)
End With
Set tbl = ThisWorkbook.Worksheets(Sheet2.Name).UsedRange
tbl.Copy
'Paste Table into MS Word
mydoc1.Paragraphs(1).Range.PasteExcelTable False, False, False
'Autofit Table so it fits inside Word Document
Set WordTable = mydoc1.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
mydoc1.Range.InsertAfter Chr(13) & "Hello"
my.Collapse Direction:=wdCollapseEnd
mydoc1.Range.InsertBreak
Set tbl = ThisWorkbook.Worksheets(Sheet3.Name).UsedRange
tbl.Copy
mydoc1.Range.PasteExcelTable False, False, False
EndRoutine:
'Clear The Clipboard
Application.CutCopyMode = False
mydoc1.SaveAs Filename:=Application.ActiveWorkbook.Path & "\Application_Temp\" & "Sheet1"
mydoc1.Close
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub