Копирование значений сводной таблицы в VBA

Question

Я создал сводную таблицу через макрос и хочу скопировать сводную таблицу в качестве значений с помощью VBA. Создание сводной таблицы прошло хорошо, но копирование на другой лист дает мне головную боль. Вот код:

Sub test() 
Dim shtTarget, pvtSht As Worksheet 
Dim pc As PivotCache 
Dim pt As PivotTable 
Dim field As PivotField 
Dim rngSource As Range 

With ActiveWorkbook 
    Set rngSource = .Sheets(2).Range("H:I").CurrentRegion 
    Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.count)) 
    shtTarget.Name = "Temp" 
    Set pc = .PivotCaches.Create(xlDatabase, rngSource, xlPivotTableVersion14) 
    Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable1", , xlPivotTableVersion14) 

End With 

With shtTarget.PivotTables("PivotTable1").PivotFields("Concatenate") 
    .Orientation = xlRowField 
    .Position = 1 
End With 

With shtTarget 
    .PivotTables("PivotTable1").AddDataField .PivotTables(_ 
    "PivotTable1").PivotFields("SCREEN_ENTRY_VALUE"), "Count of SCREEN_ENTRY_VALUE" _ 
    , xlSum 
End With 

With ActiveWorkbook 
    Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.count)) 
    pvtSht.Name = "Sum of Element Entries" 

'==========================I'm stuck on this line================================= 

    .Sheets(shtTarget).PivotTables("PivotTable1").TableRange1.Copy 
    pvtSht.Range("A1").PasteSpecial xlPasteValues 
End With 

End Sub 

Ошибка является Type mismatch ошибка.

Answer 1

Попробуй код ниже, это немного «чище», изменения, которые я сделал:

• 1) Чтобы скопировать данные сводной таблицы и вставить в другой Worksheet в качестве значения, вы должны использовать TableRange2 а не TableRange1.
• 2) Вы уже определили и установили свой pt объект так красиво на ваш PivotTable, почему бы и не использовать его? Всюду в вашем коде у вас есть shtTarget.PivotTables("PivotTable1") можно заменить на короткий pt.

Код (испытано)

Option Explicit 

Sub test() 

Dim shtTarget As Worksheet, pvtSht As Worksheet 
Dim pc As PivotCache 
Dim pt As PivotTable 
Dim field As PivotField 
Dim rngSource As Range 

With ActiveWorkbook 
    Set rngSource = .Sheets(2).Range("H:I").CurrentRegion 
    Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
    shtTarget.Name = "Temp" 

    Set pc = .PivotCaches.Create(xlDatabase, rngSource, xlPivotTableVersion14) 
    Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable1", , xlPivotTableVersion14) 
End With 

With pt.PivotFields("Concatenate") 
    .Orientation = xlRowField 
    .Position = 1 
End With 

pt.AddDataField pt.PivotFields("SCREEN_ENTRY_VALUE"), "Sum of SCREEN_ENTRY_VALUE", xlSum 

With ActiveWorkbook 
    Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
    pvtSht.Name = "Sum of Element Entries" 

    pt.TableRange2.Copy 
    pvtSht.Range("A1").PasteSpecial xlPasteValues 
End With 

End Sub