Question

背景

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

PROCESS

在TARGET_WORKBOOK中为每个业务单位创建一个标签（这是在宏之外完成的）
对于TARGET_WORKBOOK中的每个标签，都有一些有用的元数据宏导航到BUSINESS UNIT的正确文件路径（SOURCE_WORKBOOK）
打开正确的SOURCE_WORKBOOK并导航至“Auth Expense Data SOURCE_WORKBOOK中的条目“标签
将数据从SOURCE_WORKBOOK复制到TARGET_WORKBOOK，清除剪贴板缓存，关闭SOURCE_BOOK
问题 - 转到SOUCE_WORKBOOK中的下一个标签并重复步骤1

CODE

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的工作簿。

问题

我的问题发生在循环/迭代函数（“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

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

1 个答案: