Макрос Excel для создания вкладок в учетных записях

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.Count), как указано выше.После этого я получил сообщение об ошибке thisbook.Worksheets(j).Range("A1").Select, которое я решил, просто удалив его, так как казалось, что это не нужно.Кажется, сейчас все работает правильно.Спасибо за помощь.

Answer 2

В этой строке

ActiveWorkbook.Worksheets.Add after:=ActiveWorkbook.Worksheets

параметр after ожидает ссылку на один лист, а не ссылку на всю коллекцию Worksheets.

Если, например, вы хотите добавить лист в конец, вы можете использовать Count, чтобы найти последний лист, используя его в качестве индекса листа:

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

---

Удалите On Error Resume Next, если и до тех пор, пока код не будет полностью протестирован и работает. Даже тогда это должно быть последним средством и использоваться для обхода конкретной проблемы, которую можно смело игнорировать.