Array for Word bookmarks and sheet names

Question

I've been doing some VBA stuff lately but i don't know what directions to take. Someone here helped me with the copy to Word, i've lost the topic but thanks a lot! Is there a better way to read in the BookMarks and how can i get them to link the right sheet in this line;

MyArray(i) 
'needs to go in to;
wb.worksheet(Myarray(i)).range("A1:BA3000")

I've been spending way to many hours on the array part.

Private Sub ranges()

Dim NamedRange As name
    Dim nm As name
    Dim ws As Worksheet

    Dim Lr As Long
    Dim Lc As Long
    Dim Rng As range
    Dim Bm As name
    Dim wb As Workbook
    Dim Fill As range
    Dim wd As Word.Application
Set wd = New Word.Application
    Set wb = ThisWorkbook 'Workbooks("C:\Excel")
    Set aWs = ActiveSheet
'array with names of the word bookmarks
        Dim myArray(38)

myArray(0) = ("Tappunten")
myArray(1) = ("test1")
myArray(2) = ("Groslijst")
myArray(3) = ("J01_2")
myArray(4) = ("D01")
myArray(5) = ("D03")
myArray(6) = ("W01")
myArray(7) = ("W02")
myArray(8) = ("W03")
myArray(9) = ("W04")
myArray(10) = ("M01")
myArray(11) = ("M03")
myArray(12) = ("M04")
myArray(13) = ("M05")
myArray(14) = ("HJ01")
myArray(15) = ("J01")
myArray(16) = ("M02")
myArray(17) = ("J03")
myArray(18) = ("J04")
myArray(19) = ("J05")
myArray(20) = ("J06")
myArray(21) = ("J07")
myArray(22) = ("J08")
myArray(23) = ("J09")
myArray(24) = ("J10")
myArray(25) = ("J11")
myArray(26) = ("J12")
myArray(27) = ("J13")
myArray(28) = ("J14")
myArray(29) = ("J15")
myArray(30) = ("OT03")
myArray(31) = ("OT06")
myArray(32) = ("OT07")
myArray(33) = ("Checklist")
myArray(34) = ("ObjectGegevens")
myArray(35) = ("Grondstof")
myArray(36) = ("Drinkwaterinstallatie")
myArray(37) = ("WTB")
myArray(38) = ("Warmwaterleidingnet")

    'array for the worksheets on the excel sheets
        Dim myArray2(38)

myArray2(0) = Worksheets(1).name
myArray2(1) = Worksheets(1).name
myArray2(2) = Worksheets(42).name
myArray2(3) = Worksheets(17).name
myArray2(4) = Worksheets(2).name
myArray2(5) = Worksheets(15).name
myArray2(6) = Worksheets(22).name
myArray2(7) = Worksheets(3).name
myArray2(8) = Worksheets(28).name
myArray2(9) = Worksheets(29).name
myArray2(10) = Worksheets(4).name
myArray2(11) = Worksheets(6).name
myArray2(12) = Worksheets(29).name
myArray2(13) = Worksheets(46).name
myArray2(14) = Worksheets(7).name
myArray2(15) = Worksheets(16).name
myArray2(16) = Worksheets(5).name
myArray2(17) = Worksheets(13).name
myArray2(18) = Worksheets(12).name
myArray2(19) = Worksheets(47).name
myArray2(20) = Worksheets(9).name
myArray2(21) = Worksheets(13).name
myArray2(22) = Worksheets(14).name
myArray2(23) = Worksheets(14).name
myArray2(24) = Worksheets(32).name
myArray2(25) = Worksheets(1).name
myArray2(26) = Worksheets(1).name
myArray2(27) = Worksheets(1).name
myArray2(28) = Worksheets(1).name
myArray2(29) = Worksheets(8).name
myArray2(30) = Worksheets(19).name
myArray2(31) = Worksheets(33).name
myArray2(32) = Worksheets(18).name
myArray2(33) = Worksheets(27).name
myArray2(34) = Worksheets(25).name
myArray2(35) = Worksheets(36).name
myArray2(36) = Worksheets(26).name
myArray2(37) = Worksheets(20).name
myArray2(38) = Worksheets(38).name


i = 1

For Each nm In ThisWorkbook.Names
    If nm.Visible Then
        Set NamedRange = wb.Names.Item(i)
        Set ws = NamedRange.RefersToRange.Parent
    End If

        Lr = wb.worksheet(Myarray(i)).range("A1:BA3000").Find(What:="*", _ LookIn:=xlValues, _
            SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, 
            SearchFormat:=False).Row
        Lc = wb.worksheet(Myarray(i)).range("A1:BA3000").Find(What:="*", _ LookIn:=xlValues, _
            SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _
            SearchFormat:=False).Column

    Set Rng = ws.range(ws.Cells(1, 1), ws.Cells(Lr, Lc))

With wd
        .Visible = True
        .WindowState = wdWindowStateMaximize
    With .Documents.Add(Template:="C:\RABP sjabloon clean.dotx")
        With .Bookmarks
            myArray(i).range.PasteExcelTable LinkedToExcel:=False, _
                WordFormatting:=True, RTF:=False
            Rng.Copy ws.range(i)
        End With
    End With
End With
        i = i + 1
    Next nm
End Sub

Answer 1

There are 2 ways that you could populate your array:

Method 1:

myArray = Split("Tappunten test1 Groslijst ...", " ")

Method 2:

Sub LoopThroughBookmarks()
    Dim oBookmark As Bookmark
    Dim myArray() As String
    ReDim Preserve myArray(0)
    For Each oBookmark In ActiveDocument.Bookmarks
        ReDim Preserve myArray(UBound(myArray) + 1)
        myArray(UBound(myArray) - 1) = oBookmark.Name
    Next
End Sub

---

The bookmarks will be entered in the order in which they occur in the document, you may want to add some validation for the bookmarks so that you don't add some by mistake.

I've no idea how to match the bookmarks to the 2nd array :-/