copy ranges from an excel array into a work document

Any help, including links to resources, is greatly appreciated. I am attempting to copy a range A1:H238 from 42 sheets into a word document that already exists. And place each range into a bookmark that corresponds to the range.

The ranges are determined by a table that has 42 dropdown boxes, this is then referred to a database containing page names which returns the required range.

I have the following code and cant get the correct syntax to reference and copy rhe range within the array.

Option Base 1 'Force arrays to start at 1 instead of 0

Sub CreateWord()


Dim BFM As Range, BFTU As Range, BFW As Range, BFTH As Range, BFF As Range, BFSA As Range, BFSU As Range
Dim MTM As Range, MTTU As Range, MTW As Range, MTTH As Range, MTF As Range, MTSA As Range, MTSU As Range
Dim LM As Range, LTU As Range, LW As Range, LF As Range, LSA As Range, LSU As Range
Dim ATM As Range, ATTU As Range, ATW As Range, ATTH As Range, ATF As Range, ATSA As Range, ATSU As Range
Dim DM As Range, DTU As Range, DW As Range, DTH As Range, DF As Range, DSA As Range, DSU As Range
Dim SM As Range, STU As Range, SW As Range, STH As Range, SF As Range, SSA As Range, SSU As Range

Dim BFShtName As Range, MTShtName As Range, LShtName As Range, ATShtName As Range, DShtName As Range, SShtName As Range

Dim BFMRange As Range, BFTURange As Range, BFWRange As Range, BFTHRange As Range, BFFRange As Range, BFSARange As Range, BFSURange As Range
Dim MTMRange As Range, MTTURange As Range, MTWRange As Range, MTTHRange As Range, MTFRange As Range, MTSARange As Range, MTSURange As Range
Dim LMRange As Range, LTURange As Range, LWRange As Range, LTHRange As Range, LFRange As Range, LSARange As Range, LSURange As Range
Dim ATMRange As Range, ATTURange As Range, ATWRange As Range, ATTHRange As Range, ATFRange As Range, ATSARange As Range, ATSURange As Range
Dim DMRange As Range, DTURange As Range, DWRange As Range, DTHRange As Range, DFRange As Range, DSARange As Range, DSURange As Range
Dim SMRange As Range, STURange As Range, SWRange As Range, STHRange As Range, SFRange As Range, SSARange As Range, SSURange As Range

Set BFShtName = Workbooks("Menu Planning Family Master.xlsm").Sheets("Breakfast").Range("A2:BC200")
Set MTShtName = Workbooks("Menu Planning Family Master.xlsm").Sheets("Morning_Tea").Range("A2:BC200")
Set LShtName = Workbooks("Menu Planning Family Master.xlsm").Sheets("Lunch").Range("A2:BC200")
Set ATShtName = Workbooks("Menu Planning Family Master.xlsm").Sheets("Afternoon_tea").Range("A2:BC200")
Set DShtName = Workbooks("Menu Planning Family Master.xlsm").Sheets("Dinner").Range("A2:BC200")
Set SShtName = Workbooks("Menu Planning Family Master.xlsm").Sheets("Supper").Range("A2:BC200")


 '   "/Users/dylanmaley/Personal Documents/Projects/Meal Plans/Meal Plan Template.docm"

 ' SETTING LOCATIONS OF MEAL PLAN
' Week1

Set BFM = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("C3")
Set BFTU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("D3")
Set BFW = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("E3")
Set BFTH = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("F3")
Set BFF = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("G3")
Set BFSA = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("H3")
Set BFSU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("I3")

Set MTM = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("C10")
Set MTTU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("D10")
Set MTW = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("E10")
Set MTTH = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("F10")
Set MTF = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("G10")
Set MTSA = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("H10")
Set MTSU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("I10")

Set LM = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("C14")
Set LTU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("D14")
Set LW = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("E14")
Set LTH = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("F14")
Set LF = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("G14")
Set LSA = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("H14")
Set LSU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("I14")

Set ATM = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("C24")
Set ATTU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("D24")
Set ATW = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("E24")
Set ATTH = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("F24")
Set ATF = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("G24")
Set ATSA = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("H24")
Set ATSU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("I24")

Set DM = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("C27")
Set DTU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("D27")
Set DW = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("E27")
Set DTH = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("F27")
Set DF = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("G27")
Set DSA = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("H27")
Set DSU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("I27")

Set SM = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("C37")
Set STU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("D37")
Set SW = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("E37")
Set STH = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("F37")
Set SF = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("G37")
Set SSA = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("H37")
Set SSU = Workbooks("Menu Planning Family Master.xlsm").Sheets("Menu Wk1").Range("I37")

  'Vlookup and copy paste

' Week1

'BREAKFAST'

BFMShtName = Application.WorksheetFunction.VLookup(BFM, BFShtName, 55, 0)
BFTUShtName = Application.WorksheetFunction.VLookup(BFTU, BFShtName, 55, 0)
BFWShtName = Application.WorksheetFunction.VLookup(BFW, BFShtName, 55, 0)
BFTHShtName = Application.WorksheetFunction.VLookup(BFTH, BFShtName, 55, 0)
BFFShtName = Application.WorksheetFunction.VLookup(BFF, BFShtName, 55, 0)
BFSAShtName = Application.WorksheetFunction.VLookup(BFSA, BFShtName, 55, 0)
BFSUShtName = Application.WorksheetFunction.VLookup(BFSU, BFShtName, 55, 0)

'MORNING TEA'

MTMShtName = Application.WorksheetFunction.VLookup(MTM, MTShtName, 55, 0)
MTTUShtName = Application.WorksheetFunction.VLookup(MTTU, MTShtName, 55, 0)
MTWShtName = Application.WorksheetFunction.VLookup(MTW, MTShtName, 55, 0)
MTTHShtName = Application.WorksheetFunction.VLookup(MTTH, MTShtName, 55, 0)
MTFShtName = Application.WorksheetFunction.VLookup(MTF, MTShtName, 55, 0)
MTSAShtName = Application.WorksheetFunction.VLookup(MTSA, MTShtName, 55, 0)
MTSUShtName = Application.WorksheetFunction.VLookup(MTSU, MTShtName, 55, 0)

'LUNCH"

LMShtName = Application.WorksheetFunction.VLookup(LM, LShtName, 55, 0)
LTUShtName = Application.WorksheetFunction.VLookup(LTU, LShtName, 55, 0)
LWShtName = Application.WorksheetFunction.VLookup(LW, LShtName, 55, 0)
LTHShtName = Application.WorksheetFunction.VLookup(LTH, LShtName, 55, 0)
LFShtName = Application.WorksheetFunction.VLookup(LF, LShtName, 55, 0)
LSAShtName = Application.WorksheetFunction.VLookup(LSA, LShtName, 55, 0)
LSUShtName = Application.WorksheetFunction.VLookup(LSU, LShtName, 55, 0)

'AFTERNOON TEA'

ATMShtName = Application.WorksheetFunction.VLookup(ATM, ATShtName, 55, 0)
ATTUShtName = Application.WorksheetFunction.VLookup(ATTU, ATShtName, 55, 0)
ATWShtName = Application.WorksheetFunction.VLookup(ATW, ATShtName, 55, 0)
ATTHShtName = Application.WorksheetFunction.VLookup(ATTH, ATShtName, 55, 0)
ATFShtName = Application.WorksheetFunction.VLookup(ATF, ATShtName, 55, 0)
ATSAShtName = Application.WorksheetFunction.VLookup(ATSA, ATShtName, 55, 0)
ATSUShtName = Application.WorksheetFunction.VLookup(ATSU, ATShtName, 55, 0)

'DINNER'

DMShtName = Application.WorksheetFunction.VLookup(DM, DShtName, 55, 0)
DTUShtName = Application.WorksheetFunction.VLookup(DTU, DShtName, 55, 0)
DWShtName = Application.WorksheetFunction.VLookup(DW, DShtName, 55, 0)
DTHShtName = Application.WorksheetFunction.VLookup(DTH, DShtName, 55, 0)
DFShtName = Application.WorksheetFunction.VLookup(DF, DShtName, 55, 0)
DSAShtName = Application.WorksheetFunction.VLookup(DSA, DShtName, 55, 0)
DSUShtName = Application.WorksheetFunction.VLookup(DSU, DShtName, 55, 0)

'SUPPER'

SMShtName = Application.WorksheetFunction.VLookup(SM, SShtName, 55, 0)
STUShtName = Application.WorksheetFunction.VLookup(STU, SShtName, 55, 0)
SWShtName = Application.WorksheetFunction.VLookup(SW, SShtName, 55, 0)
STHShtName = Application.WorksheetFunction.VLookup(STH, SShtName, 55, 0)
SFShtName = Application.WorksheetFunction.VLookup(SF, SShtName, 55, 0)
SSAShtName = Application.WorksheetFunction.VLookup(SSA, SShtName, 55, 0)
SSUShtName = Application.WorksheetFunction.VLookup(SSU, SShtName, 55, 0)

'Setting Ranges for Copy

 Set BFMRange = Sheets(BFMShtName).Range("A1:H238")
 Set BFTURange = Sheets(BFTUShtName).Range("A1:H238")
 Set BFWRange = Sheets(BFWShtName).Range("A1:H238")
 Set BFTHRange = Sheets(BFTHShtName).Range("A1:H238")
 Set BFFRange = Sheets(BFFShtName).Range("A1:H238")
 Set BFSARange = Sheets(BFSAShtName).Range("A1:H238")
 Set BFSURange = Sheets(BFSUShtName).Range("A1:H238")

 Set MTMRange = Sheets(MTMShtName).Range("A1:H238")
 Set MTTURange = Sheets(MTTUShtName).Range("A1:H238")
 Set MTWRange = Sheets(MTWShtName).Range("A1:H238")
 Set MTTHRange = Sheets(MTTHShtName).Range("A1:H238")
 Set MTFRange = Sheets(MTFShtName).Range("A1:H238")
 Set MTSARange = Sheets(MTSAShtName).Range("A1:H238")
 Set MTSURange = Sheets(MTSUShtName).Range("A1:H238")

 Set LMRange = Sheets(LMShtName).Range("A1:H238")
 Set LTURange = Sheets(LTUShtName).Range("A1:H238")
 Set LWRange = Sheets(LWShtName).Range("A1:H238")
 Set LTHRange = Sheets(LTHShtName).Range("A1:H238")
 Set LFRange = Sheets(LFShtName).Range("A1:H238")
 Set LSARange = Sheets(LSAShtName).Range("A1:H238")
 Set LSURange = Sheets(LSUShtName).Range("A1:H238")

 Set ATMRange = Sheets(ATMShtName).Range("A1:H238")
 Set ATTURange = Sheets(ATTUShtName).Range("A1:H238")
 Set ATWRange = Sheets(ATWShtName).Range("A1:H238")
 Set ATTHRange = Sheets(ATTHShtName).Range("A1:H238")
 Set ATFRange = Sheets(ATFShtName).Range("A1:H238")
 Set ATSARange = Sheets(ATSAShtName).Range("A1:H238")
 Set ATSURange = Sheets(ATSUShtName).Range("A1:H238")

 Set DMRange = Sheets(DMShtName).Range("A1:H238")
 Set DTURange = Sheets(DTUShtName).Range("A1:H238")
 Set DWRange = Sheets(DWShtName).Range("A1:H238")
 Set DTHRange = Sheets(DTHShtName).Range("A1:H238")
 Set DFRange = Sheets(DFShtName).Range("A1:H238")
 Set DSARange = Sheets(DSAShtName).Range("A1:H238")
 Set DSURange = Sheets(DSUShtName).Range("A1:H238")

 Set SMRange = Sheets(SMShtName).Range("A1:H238")
 Set STURange = Sheets(STUShtName).Range("A1:H238")
 Set SWRange = Sheets(SWShtName).Range("A1:H238")
 Set STHRange = Sheets(STHShtName).Range("A1:H238")
 Set SFRange = Sheets(SFShtName).Range("A1:H238")
 Set SSARange = Sheets(SSAShtName).Range("A1:H238")
 Set SSURange = Sheets(SSUShtName).Range("A1:H238")


 Dim tbl As Range
 Dim WordApp As Object
 Dim myDoc As Object
 Dim WordTable As Word.Table
 Dim TableArray As Variant
 Dim BookmarkArray As Variant
 Dim Bookmark As Word.Range
 Dim SheetArray As Variant
 Dim i As Integer
 Dim arr(1 To 4) As Variant

 arr(1) = BFMRange
 arr(2) = BFTURange
 arr(3) = BFWRange
 arr(4) = BFTHRange

 'List of excel sheetnames
 '   SheetArray = Array("BFMShtName", "BFTUShtName", "BFWShtName", 
"BFTHShtName")

  'List of Table Ranges
  'TableArray = Array("BFMRange", "BFTURange", "BFWRange", "BFTHRange")

     'List of Word Document Bookmarks (To Paste To)
   BookmarkArray = Array("BFM", "BFTU", "BFW", "BFTH")


  'Set Variable Equal To Destination Word Document
  'On Error GoTo WordDocNotFound
    Set WordApp = CreateObject("Word.Application")
    WordApp.Documents.Open ("/Users/dylanmaley/Personal Documents/Meal 
Plans/Meal Plan Template.docm")
    WordApp.Visible = True
    Set myDoc = WordApp.Documents("/Users/dylanmaley/Personal Documents/Meal 
Plans/Meal Plan Template.docm")
  '  On Error GoTo 0


    For i = 1 To 4



    'Copy Table Range from Excel
    tbl = arr(1)
     tbl.Copy


     'tbl.Copy

  'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
    myDoc.Bookmarks(BookmarkArray(i)).Range.PasteExcelTable


  Next i

'Completion Message
 MsgBox "Copy/Pasting Complete!", vbInformation
 'GoTo EndRoutine

'ERROR HANDLER
'WordDocNotFound:
'  MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently 
open, aborting.", 16

   End Sub
728x90

0 Answers copy ranges from an excel array into a work document