Question

Sub CostCenterMarco2014()

Dim xlCalc As XlCalculation
Dim CC As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ccf As Range
Dim ccl As Range
Dim tt As Integer

    On Error Resume Next

'   Turn off events and screen updating
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Set thisbook = ActiveWorkbook

    ' Iteration over SAP cost centers
    For i = 2 To 30
        CC = thisbook.Worksheets(1).Cells(i, 1).Value
        thisbook.Worksheets("Summary").Range("B2").Value = CC
        thisbook.Worksheets("Summary").Calculate
        Workbooks.Add
        thisbook.Worksheets("Summary").Range("A1:Z100").Copy
        ActiveWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteFormats
        ActiveWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
        ActiveWorkbook.Worksheets("Sheet1").Columns("A:Z").AutoFit

        ' Iteration over 5 sheets
        For j = 4 To 7
            ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Worksheets
            ActiveWorkbook.Worksheets(j).Name = thisbook.Worksheets(j).Name

            'Copy header row
            thisbook.Worksheets(j).Rows(1).Copy Destination:=ActiveWorkbook.Worksheets(j).Range("A1")

            ' Depending on the format of header row
            'tt = ActiveWorkbook.Worksheets(j).Range("A1").CurrentRegion.Columns.Count
            tt = ActiveWorkbook.Worksheets(j).Range("IV1").End(xlToLeft).Column
            With thisbook.Worksheets(j)
                Set ccf = .Range("A:A").Find(what:=CC, after:=.Cells(1, 1), LookIn:=xlValues, SearchDirection:=xlNext)

                If Not ccf Is Nothing Then
                    Set ccl = .Range("A:A").FindPrevious(after:=ccf)
                    .Range(.Cells(ccf.Row, 1), .Cells(ccl.Row, tt)).Copy Destination:=ActiveWorkbook.Worksheets(j).Range("A2")
                End If
            End With

            Application.CutCopyMode = False

            ActiveWorkbook.Worksheets(j).Range("A1").CurrentRegion.Columns.AutoFit
            thisbook.Worksheets(j).Range("A1").Select
        Next j

        ActiveWorkbook.Worksheets("Sheet1").Name = "Summary"
        ActiveWorkbook.Worksheets("Sheet2").Delete
        ActiveWorkbook.Worksheets("Sheet3").Delete
        ActiveWorkbook.Worksheets("Summary").Select
        ActiveWorkbook.Worksheets("Summary").Range("A1").Select



        ActiveWorkbook.SaveAs Filename:="\\REDACTED\2.February 2019\Monthly Expense Report February 2019-" & CC '& ".xlsx"
        ActiveWorkbook.Close
    Next i


'   Turn on events and screen updating
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = False
    End With

    On Error GoTo 0

End Sub

因此，我一般不会完全了解编码。我在大学里上了几节课，所以我觉得我至少可以感觉到自己通过这门课的方式。这个宏是由不再在我公司工作的人提供给我的。大部分都按预期工作，上个月完全工作。

本月，“ 5张纸上的迭代”部分似乎并不起作用。我尝试遍历该宏，它创建了一个新的工作簿并将摘要信息粘贴到其中，但是当要复制选项卡时，它不会复制我需要的4个详细信息选项卡甚至它们的名称。

我最终得到的是所有单个成本中心在其自己的文件中，并具有预期的摘要，但是未复制明细标签。任何帮助表示赞赏。

Answer 1

在这一行

ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Worksheets

after参数需要一个工作表引用，而不是整个Worksheets集合的引用。

例如，如果要在页面末尾添加工作表，则可以使用Count来查找最后一个工作表，并将其用作工作表索引：

ActiveWorkbook.Worksheets.Add _ 
    after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)

删除On Error Resume Next，除非并且直到该代码已经过全面测试并且可以正常工作。即使这样，这也应该是最后的手段，并且可以用来规避可以安全忽略的特定问题。

Answer 2

在删除了令人讨厌的错误块之后，我不得不如上所述添加(ActiveWorkbook.Worksheets.Count)。之后，我在thisbook.Worksheets(j).Range("A1").Select遇到了一个错误，我通过删除它来解决了这个错误，因为好像不需要它了。现在一切似乎都正常运行。感谢您的所有帮助。

Excel Macro可以拆分选项卡以帐户特定的工作簿

2 个答案: