Excel VBA Page Breaks - vba

Question

I have a workbook full of worksheets I'm trying to copy and paste the contents of into a word document. Right now the code loops through all the worksheets and pastes them into a word document, but on top of each other. I had to change wdDoc.Range(wdDoc.Characters.Count - 1).Paste to wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False and I'm not sure if this is the source of the problem; it does seem like a new page is being created, but the contents of the next worksheet just aren't being pasted into it. I'm not getting any error messages. Any advice would be appreciated!
Sub toWord()
Dim ws As Worksheet
Dim fromWB As Variant
Dim wdApp As Object
Dim wdDoc As Object
Dim docName As Variant
Dim rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
'Creates InputBox that allows user to enter name to save document as
docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2)
wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name
fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data")
If fromWB <> False Then
Set fromWB = Workbooks.Open(fromWB)
ElseIf fromWB = False Then
MsgBox "No File Selected"
GoTo ResetSettings
End If
For Each ws In fromWB.Worksheets
ws.Activate
ws.Range("A1:A2").Select
Selection.Copy
Set wdApp = GetObject(, "Word.Application")
wdApp.Visible = True
wdDoc.Activate
wdDoc.Range.Paste
ws.Activate
If ws.Range("A3").Value <> "" Then
Range("A2").CurrentRegion.Offset(2).Resize(Range("A2").CurrentRegion.Rows.Count - 2).Select
Selection.Columns.AutoFit
Selection.Copy
Set wdApp = GetObject(, "Word.Application")
wdApp.Visible = True
wdDoc.Activate
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
wdApp.Selection.TypeParagraph
wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False
wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
wdDoc.Range.Collapse Direction:=0
wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
End If
Next ws
wdDoc.Styles("Normal").NoSpaceBetweenParagraphsOfSameStyle = True
wdDoc.Save
Set wdDoc = Nothing
Set wdApp = Nothing
Set fromWB = Nothing
MsgBox "Imported into Word Document"
ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Answer 1

Placeholder edit while testing:
Sub asdf()
Dim ws As Worksheet
Const wdStory = 6
Const wdMove = 0
For Each ws In ThisWorkbook.Worksheets
ws.Range("A7").Copy
Set docApp = GetObject(, "Word.Application")
Set doc = docApp.Documents.Open("PATH OF FILE")
docApp.Selection.EndKey wdStory
docApp.Selection.PasteAndFormat wdPasteDefault
Next ws
End Sub

Answer 2

Here's the code I got to work:
Sub toWord()
Dim ws As Worksheet
Dim fromWB As Variant
Dim wdApp As Object
Dim wdDoc As Object
Dim docName As Variant
Dim rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
'Creates InputBox that allows user to enter name to save document as
docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2)
wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name
fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data")
If fromWB <> False Then
Set fromWB = Workbooks.Open(fromWB)
ElseIf fromWB = False Then
MsgBox "No File Selected"
GoTo ResetSettings
End If
For Each ws In fromWB.Worksheets
ws.Activate
ws.Range("A1:A2").Select
Selection.Copy
Set wdApp = GetObject(, "Word.Application")
wdApp.Visible = True
wdDoc.Activate
wdDoc.Range(wdDoc.Characters.Count - 1).Paste
ws.Activate
If ws.Range("A4").Value <> "" Then
Application.Intersect(ws.UsedRange, ws.Cells.Resize(ws.Rows.Count - 2).Offset(2)).Select
Selection.Columns.AutoFit
Selection.Copy
Set wdApp = GetObject(, "Word.Application")
wdApp.Visible = True
wdDoc.Activate
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
wdApp.Selection.TypeParagraph
wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False
wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
wdApp.Selection.Collapse Direction:=0
wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
Else
wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
End If
Next ws
wdDoc.Styles("No Spacing").NoSpaceBetweenParagraphsOfSameStyle = True
wdDoc.Save
Set wdDoc = Nothing
Set wdApp = Nothing
Set fromWB = Nothing
MsgBox "Imported into Word Document"
ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub