Сбой создания сводной таблицы на разных листах на втором листе - PullRequest
Новая
       8

Сбой создания сводной таблицы на разных листах на втором листе

0 голосов
/ 13 июля 2020

Я новичок в программировании на VBA, и это один из моих первых кодов, которые я пишу.

Назначение кода : я хотел бы взять данные на листе счетов и разобрать их на разные листы на основе последнего столбца. Затем на каждом листе создайте сводную таблицу для данных.

Код довольно длинный - я уверен, что в нем довольно много ненужных шагов, но на 90% это нормально. Фаст-лист создан идеально. Также создается первая точка поворота. Затем создается второй лист.

Проблема : макрос запускается с ошибкой, когда пытается создать сводную таблицу для второго листа.

Сообщение об ошибке : Ошибка времени выполнения '5': Неверный вызов процедуры или аргумент

Кто-нибудь знает, почему мой макрос не работает на втором листе? Спасибо за помощь! Пожалуйста, посмотрите код ниже. Проблема возникает после комментария создания сводной таблицы 

Sub copypaste()

Application.ScreenUpdating = False
'Declarations
Dim ws As Worksheet
Dim wb As Workbook
Dim cell As Range
Dim rng As Range
Dim rng1 As Range
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long
Dim Counter As Integer


Set wb = ActiveWorkbook
Set ws2 = wb.Sheets("Invoices")
Counter = 0
Debug.Print Counter

'get the number of rows in the invoices sheet
LastRow = ws2.Range("A1", ws2.Range("A1").End(xlDown)).Rows.Count

'plus invoice type and sum column creation
ws2.Select
Columns(6).Select
Range("F:F").Insert
Cells(1, 6) = "Invoice type"
Range("F2:F" & LastRow).Formula = "=LEFT(RC[1],4)"
Selection.Columns.AutoFit
Columns(19).Select
Range("S:S").Insert
Cells(1, 19) = "Sum"
Range("S2:S" & LastRow).Formula = "=SUM(RC[-8]:RC[-1])"
Selection.Style = "Comma"
Selection.NumberFormat = _
    "_-* #,##0.0 _F_t_-;-* #,##0.0 _F_t_-;_-* ""-""?? _F_t_-;_-@_-"
Selection.NumberFormat = _
    "_-* #,##0 _F_t_-;-* #,##0 _F_t_-;_-* ""-""?? _F_t_-;_-@_-"
Selection.Columns.AutoFit

'sorbarendezés debtor name és invoice no. szerint
ws2.Sort.SortFields.Clear
Range("A1:R" & LastRow).Sort Key1:=Range("E1"), Header:=xlYes, Key2:=Range("G1")

'list creation as a basis for filtering and taking apart the data

wb.Activate
ws2.Select
Range("A1").Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Set ws3 = Sheets.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:= _
    xlYes
Range("A2").Select
Set rng1 = Range(Selection, Selection.End(xlDown))
ws3.Select
ws3.Name = "kódolás"
Set ws = wb.Sheets("kódolás")

wb.Activate
ws.Select
'go through the earlier created list and take apart the data related to each item of the list to separate sheets
For Each cell In rng1
    Counter = Counter + 1
    Debug.Print Counter
    'filtered data copy
    ws2.Select
    Range("A1").Select
    ws2.Range("$A$1:$W$198162").AutoFilter Field:=20, Criteria1:=cell
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    'new sheet creation
    With wb
        .Sheets.Add after:=.Sheets(.Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = cell.Value
        If Err.Number = 1004 Then
            Debug.Print cell.Value & " already used as a sheet name"
        End If
        On Error GoTo 0
    End With
    'filtered data paste
    ActiveSheet.Paste
    ActiveCell.Rows("1:1").EntireRow.Select
    Application.CutCopyMode = False
    'go back to A1
    Range("A1").Select



    'Creation of pivot table


    
    LastRow2 = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlDown)).Rows.Count
    
    ActiveCell.Range("A1:T" & LastRow2).Select
    
    Debug.Print Counter
    Debug.Print LastRow2
    Debug.Print ActiveSheet.Name & "!" & "R1C1:R" & LastRow2 & "C19"
    Debug.Print ActiveSheet.Name & "!" & "R1C23"
    Debug.Print "PivotTable" & Counter
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        ActiveSheet.Name & "!" & "R1C1:R" & LastRow2 & "C19", Version:=6).CreatePivotTable TableDestination:= _
        ActiveSheet.Name & "!" & "R1C23", TableName:="PivotTable" & Counter, DefaultVersion:=6
    ActiveSheet.Select
    Cells(1, 27).Select
    With ActiveSheet.PivotTables("PivotTable" & Counter)
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable" & Counter).PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable" & Counter).RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable" & Counter).PivotFields("Debtor name")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable" & Counter).PivotFields("invoice type")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable" & Counter).AddDataField ActiveSheet.PivotTables( _
        "PivotTable" & Counter).PivotFields("SUM"), "Sum of SUM", xlSum 
    
    'take out filter and go back to A1
    ws2.Select
    Application.CutCopyMode = False
    Range("A1").Select
    ws2.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.ShowAllData
Next cell

End Sub
...