ピボットテーブルの集計結果は「sheet１」に出力されます。集計結果を

質問

ピボットテーブルの集計結果は「sheet１」に出力されます。集計結果を繰り返し出力すると「sheet2」、「sheet3」・・・・と続きますが、集計結果を出力するたびに同じシートに上書きしてすることはできないでしょうか？

これをVBAで行いたいのでコードを教えていただけると幸いです。

ちなみに、以下のコードをWEBで見つけシートモジュールに置きましたが、上手く動きませんでた。
'SheetModule
Option Explicit
'-------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
　　　　　　　　　　　　　　　　　　　　Cancel As Boolean)
　　If Me.PivotTables.Count = 0 Then Exit Sub
　　Dim r As Range
　　On Error Resume Next
　　Set r = Intersect(Target, Target.PivotTable.DataBodyRange)
　　On Error GoTo 0
　　If Not r Is Nothing Then
　　　　Application.OnTime Now, Me.CodeName & ".test1"
　　　　Set r = Nothing
　　End If
End Sub
'-------------------------------------------------
Private Sub test1()
　　Const sName = "pvtDetail"
　　On Error Resume Next
　　Application.DisplayAlerts = False
　　Sheets(sName).Delete
　　Application.DisplayAlerts = True
　　On Error GoTo 0
　　ActiveSheet.Name = sName
End Sub
'-------------------------------------------------

私の書いたピボットテーブルの標準モジュールは以下になります。

Sub 廃止部品と使用製品一覧作成(ByVal Arg)

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"対象一覧!" & Arg).CreatePivotTable TableDestination:="", TableName:= _
"ピボットテーブル1"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("ピボットテーブル1").SmallGrid = False
ActiveSheet.PivotTables("ピボットテーブル1").AddFields RowFields:=Array("EAB品番", _
"SEB品番", "使用製品名", "生産場所"), ColumnFields:=Array("メーカー名", "メーカー品名")
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("使用数").Orientation = _
xlDataField

End Sub

私のコードが悪くWEBで見つけたコードが動かないのか分かりませんが、ピボットテーブルの出力結果を常に同じシートに上書きするコードが知りたいです。

よろしくお願い致します。

回答No.2

imogasi

マクロの記録を採って、どう変えるべきか考えれば済むことでは。
計数データなどがどう変わるのか、データ行数がどう変わるかーー＞対応は易しい（変更不要）。
計数項目PivotFieldsは通常１つで固定かと思う。
ピボット表の行RowFields、列ColumnFieldsが同じか、変わるのかーー＞この点質問になにも書いてない。
だから質問内容を誤解しているかもしれないが、
ピボット表をSheet2にいつも出すなら下記でどうですか。（.Cells.Clearを効かす。）
シート名、フィールドの名前は質問者のケースに変えてください。行RowFields、列ColumnFieldsはArrayで複数指定できる。
これも都度指定する質問なら、VBAで毎回やるメリットは少ないと思う。
Sub Macro1()
With Worksheets("Sheet1")
Set rng = .Range("a1").CurrentRegion
r = .Range("a1").CurrentRegion.Rows.Count: MsgBox r
c = .Range("a1").CurrentRegion.Columns.Count: MsgBox c
End With
With Worksheets("Sheet2")
.Cells.Clear
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
rng).CreatePivotTable TableDestination:=.Range("A1"), TableName:="ピボットテーブル1", DefaultVersion:= _
xlPivotTableVersion10

.PivotTables("ピボットテーブル1").AddFields RowFields:=Array("コード１", "コード３"), _
ColumnFields:=Array("コード２")
.PivotTables("ピボットテーブル1").PivotFields("計数").Orientation = _
xlDataField
End With
End Sub
少数例でテスト済み。
なおコマンドボタンのクリックイベントにするなどの部分は問題ないと思うので略している。

お礼

回答ありがとうございました。
参考にさせていただきました。

回答No.1

end-u

http://okwave.jp/qa/q6190531.html
そのコードは既存ピボットの[詳細データの表示]に関するものですから
使えません。
TableDestinationが新規ピボット作成先です。

Dim ws As Worksheet
Dim pt As PivotTable

With ActiveWorkbook
　　Set ws = .Worksheets("sheet1")
　　'"sheet1"の既存Pivotをクリア
　　For Each pt In ws.PivotTables
　　　　pt.TableRange2.Clear
　　Next

　　With .PivotCaches.Add(SourceType:=xlDatabase, _
　　　　　　　　　　　　　SourceData:="対象一覧!" & Arg) _
　　　　　　　　　　 .CreatePivotTable( _
　　　　　　　　　　　　　TableDestination:=ws.Range("A1"))
　　　　.SmallGrid = False
　　　　.AddFields RowFields:=Array("EAB品番", _
　　　　　　　　　　　　　　　　　　"SEB品番", _
　　　　　　　　　　　　　　　　　　"使用製品名", _
　　　　　　　　　　　　　　　　　　"生産場所"), _
　　　　　　　　　 ColumnFields:=Array("メーカー名", _
　　　　　　　　　　　　　　　　　　　 "メーカー品名")
　　　　.PivotFields("使用数").Orientation = xlDataField
　　End With
End With
Set ws = Nothing

お礼

ありうがとうございました。無事に希望通りの動きができました。