在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，爲什麼不繼續使用它？你的代碼中的任何地方都可以用pt代替shtTarget.PivotTables("PivotTable1")。

代碼（測試）

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