copy ranges from an excel array into a work document
0
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
arrays copy paste
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
add a comment |
0
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
arrays copy paste
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
I have found a work around for this. thank you
– Dylan Maley
Nov 22 '18 at 0:32
add a comment |
0
0
0
1
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
arrays copy paste
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
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
arrays copy paste
arrays copy paste
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
asked Nov 20 '18 at 1:50
Dylan MaleyDylan Maley
12
12
I have found a work around for this. thank you
– Dylan Maley
Nov 22 '18 at 0:32
add a comment |
I have found a work around for this. thank you
– Dylan Maley
Nov 22 '18 at 0:32
I have found a work around for this. thank you
– Dylan Maley
Nov 22 '18 at 0:32
I have found a work around for this. thank you
– Dylan Maley
Nov 22 '18 at 0:32
add a comment |
0
active
oldest
votes
Your Answer
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53385114%2fcopy-ranges-from-an-excel-array-into-a-work-document%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
0
active
oldest
votes
0
active
oldest
votes
active
oldest
votes
active
oldest
votes
draft saved
draft discarded
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53385114%2fcopy-ranges-from-an-excel-array-into-a-work-document%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
I have found a work around for this. thank you
– Dylan Maley
Nov 22 '18 at 0:32