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

Вопрос: Я создал сводную таблицу с помощью макроса и хочу скопировать сводную таблицу в качестве значений с помощью VBA. Создание сводной таблицы прошло хорошо, но копирование на другой лист дает мне головную боль. Здесь код: Sub test() Dim shtTarget, pvtSht As Worksheet Dim pc As PivotCache Dim pt As PivotTable Dim field As PivotField Dim

Вопрос:

Я создал сводную таблицу с помощью макроса и хочу скопировать сводную таблицу в качестве значений с помощью 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.

Лучший ответ:

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

  • 1) Чтобы скопировать данные сводной таблицы и вставить в другой TableRange2 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

Оцените статью
Добавить комментарий