Любая помощь, включая ссылки на ресурсы, высоко ценится.Я пытаюсь скопировать диапазон A1: H238 из 42 листов в текстовый документ, который уже существует.И поместите каждый диапазон в закладку, которая соответствует диапазону.
Диапазоны определяются таблицей с 42 раскрывающимися списками, которая затем ссылается на базу данных, содержащую имена страниц, которая возвращает требуемый диапазон.
У меня есть следующий код, и я не могу получить правильный синтаксис для ссылки и копирования диапазона в массиве.
Опция Base 1 'Массивы должны начинаться с 1 вместо 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