Excel VBA copy pasting each named range to word - vba

Question

I have dynamic named range of cell. I need to paste each named range in one page of word and move to next page for next named range. I tried copule of code, I am unable to do.Each named range data is overlapping each other. Can anyone help me, please.
Set wbBook = ActiveWorkbook
Set rs = wbBook.Names(1).RefersToRange
For i = 2 To wbBook.Names.Count
Set rs = Union(rs, wbBook.Names(i).RefersToRange)
Next
rs.Copy
With wd.Range
.Collapse Direction:=0
.InsertParagraphAfter
.Collapse Direction:=0
.PasteSpecial False, False, True
Application.CutCopyMode = False
End With

Answer 1

It sounds like you want to copy each range onto different pages so I'm not sure why you're using a union. Here is a quick example of copying each named range 'name' onto a new sheet in a word document. Note: I created a new doc for simplicity.
Edit - I added copy/paste functionality of data to the end. Formatting and such depends on what you have or want.
Sub main()
'Create new word document
Dim objWord As Object
Dim objDoc As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.documents.Add()
Dim intCounter As Integer
Dim rtarget As Word.Range
Dim wbBook As Workbook
Set wbBook = ActiveWorkbook
'Loop Through names
For intCounter = 1 To wbBook.Names.Count
Debug.Print wbBook.Names(intCounter)
With objDoc
Set rtarget = .Range(.Content.End - 1, .Content.End - 1)
'Insert page break if not first page
If intCounter > 1 Then rtarget.insertbreak Type:=wdPageBreak
'Write name to new page of word document
rtarget.Text = wbBook.Names(intCounter).Name & vbCr
'Copy data from named range
Range(wbBook.Names(intCounter)).Copy
Set rtarget = .Range(.Content.End - 1, .Content.End - 1)
rtarget.Paste
End With
Next intCounter
End Sub
Excel
Resulting Word Document

Answer 2

I don't think this is the best solution out there (as I don't normally play with Word VBA) but I have tried this and it does seems to work:
Sub AddNamedRangesToWordDoc()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim intCount As Integer
Dim oRng As Range
Dim oSelection As Object
Set oWord = New Word.Application
Set oDoc = oWord.Documents.Add
oWord.Visible = True
For intCount = 1 To ActiveWorkbook.Names.Count
Set oRng = Range(ActiveWorkbook.Names(intCount).RefersToRange.Name.Name)
oRng.Copy
oDoc.ActiveWindow.Selection.PasteSpecial , , 0
Set oSelection = oWord.Selection
oSelection.InsertBreak (wdPageBreak)
Next
Set oSelection = Nothing
Set oRng = Nothing
Set oDoc = Nothing
Set oWord = Nothing
End Sub
NOTE: I am creating a new word application. You might have to check if word is already open and how you want to deal with an existing word doc. Also, I'm not creating the word object. I have Microsoft Word xx.x Object Library referenced in the project as I prefer to work with built in libraries. Also, function presumes that you only have 1 worksheet and all your ranges are in that worksheet