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