迭代通过工作簿; 将数据复制并粘贴到新的工作簿

背景

我收到了来自世界各地不同业务单位的一系列excel工作簿（授权费用）。 我的目标是创build一个macros，打开每个商业单位的工作簿，复制他们的费用数据，并将其粘贴到主文件中，以便于比较。

处理

1. 为TARGET_WORKBOOK中的每个BUSINESS UNIT创build一个选项卡（ 这是在macros的外部完成的 ）

2. 对于TARGET_WORKBOOK中的每个选项卡，都有一些元数据可以帮助macros浏览商业单位的正确文件path（SOURCE_WORKBOOK）

3. 打开正确的SOURCE_WORKBOOK并导航到SOURCE_WORKBOOK中的“Auth Expense Data Entry”选项卡
4. 将数据从SOURCE_WORKBOOK复制到TARGET_WORKBOOK，清除剪贴板caching，closuresSOURCE_BOOK
5. 问题 – 移至SOUCE_WORKBOOK中的下一个选项卡并重复步骤1

码

Sub AllUnits() Dim Current As Worksheet 'For every worksheet in workbook, call AuthExpense function For Each Current In ThisWorkbook.Worksheets Call AuthExpense(Current) Next Current End Sub Sub AuthExpense(Current As Worksheet) Dim Target_Workbook As Workbook Dim Source_Workbook As Workbook Dim Source_Path As String 'Configure macro for business-specific unit BusinessUnit = ActiveSheet.Name BusinessName = ActiveSheet.Cells(2, 2) 'Declare Target & Source workbooks w/ relative paths Set Target_Workbook = ThisWorkbook Source_Path = ThisWorkbook.Path & "\Business Unit Monthly Reporting Template_" & BusinessName & ".xlsx" Set Source_Workbook = Workbooks.Open(Source_Path) 'Copy Source Workbook to Target Workbook Source_Workbook.Sheets("Auth Expense Data Entry").Range("A1:H150").Copy 'Paste Special Source data to Target workbook Target_Workbook.Sheets(BusinessUnit).Range("A5").PasteSpecial Paste:=xlPasteValues 'Clear clipboard cache and close Application.CutCopyMode = False Source_Workbook.Close (False) End Sub 

注意

• 我可以成功打开，复制，粘贴，清除剪贴板caching，并closures一个商业单位的工作簿。

问题

1. 我的问题发生在循环/迭代函数（“AllUnits（）”）。 当macros运行时，主Excel文件复制/粘贴10次相同的业务单位数据（在同一工作表上，覆盖自身）。 我相信当我尝试移动到主文件上的下一个选项卡时，会出现我的问题。 有什么build议么？

Answer 1

你的AllUnits()子没有问题。 它应该循环放置在工作簿中的工作表中。必须将您的AuthExpense更改为不引用ActiveSheet 。 您永远不会激活您的AllUnits()子表中的工作表，因此下一个工作表不是活动工作表。 使用下面的。

 Sub AllUnits() Dim Current As Worksheet 'For every worksheet in workbook, call AuthExpense function For Each Current In ThisWorkbook.Worksheets Call AuthExpense(Current) Next Current End Sub Sub AuthExpense(Current As Worksheet) Dim Target_Workbook As Workbook Dim Source_Workbook As Workbook Dim Source_Path As String 'Configure macro for business-specific unit BusinessUnit = Current.Name BusinessName = Current.Cells(2, 2) 'Declare Target & Source workbooks w/ relative paths Set Target_Workbook = ThisWorkbook Source_Path = ThisWorkbook.Path & "\Business Unit Monthly Reporting Template_" & BusinessName & ".xlsx" Set Source_Workbook = Workbooks.Open(Source_Path) 'Copy Source Workbook to Target Workbook Source_Workbook.Sheets("Auth Expense Data Entry").Range("A1:H150").Copy 'Paste Special Source data to Target workbook Target_Workbook.Sheets(BusinessUnit).Range("A5").PasteSpecial Paste:=xlPasteValues 'Clear clipboard cache and close Application.CutCopyMode = False Source_Workbook.Close (False) End Sub