遍历工作簿；将数据复制并粘贴到新工作簿

Question

背景

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

过程

1. 为 TARGET_WORKBOOK 中的每个业务单元创建一个选项卡（这是在宏之外完成的）

2. 对于 TARGET_WORKBOOK 中的每个选项卡，都有一些元数据可以帮助 导航到业务单元的正确文件路径的宏 (SOURCE_WORKBOOK)

3. 打开正确的 SOURCE_WORKBOOK 并导航到“Auth Expense Data SOURCE_WORKBOOK 中的“条目”选项卡
4. 将数据从 SOURCE_WORKBOOK 复制到 TARGET_WORKBOOK，清除剪贴板 缓存，关闭 SOURCE_BOOK
5. ISSUE - 移动到 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

注意

• 我可以成功打开、复制、粘贴、清除剪贴板缓存以及关闭 BUSINESS UNIT 的工作簿。

问题

1. 我的问题出现在循环/迭代函数（“AllUnits()”）中。宏运行时，主 Excel 文件复制/粘贴同一业务部门的数据 10 次（在同一工作表上，覆盖自身）。我相信当我尝试移至主文件的下一个选项卡时会出现我的问题。有什么建议吗？

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