マクロでピポッドテーブルを複数作成

今ボタンを押下すると自動的にピポッドテーブルを作成するマクロを作成しています。
【Sample】
Sub ボタン2_Click()
Dim r As Range

With ActiveWorkbook

'With Sheets("案件一覧（DSG）").Select
With .Sheets("案件一覧（DSG）")
Set r = .Range("W2", .Range("B2").End(xlDown))
End With
With .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=r.Address(external:=True))
With .CreatePivotTable(TableDestination:="")
.AddFields RowFields:="製品区分"
With .PivotFields("見込" & Chr(10) & "受注金額")
.Orientation = xlDataField
.Caption = "合計 : 金額"
.Function = xlSum
End With
End With
End With
End With
Set r = Nothing

End Sub

上記のようなピポッドテーブルを新規”サマリー”ワークシートに作成し、同じデータ領域から同じ”サマリー”ワークシートに複数ピポッドテーブルを作成したいと考えています。

A1に作成した後はD1、H1という感じで上記では製品区分別の受注金額をサマリーしていますが、その他業種区分別や担当者別にピポッドテーブルが作成出来たらと思います。

マクロ初心者で今学習で申し訳ありませんが、どなたかご教授よろしくお願いいたします。

以上

No.1 ベストアンサー 回答者： end-u 回答日時： 2009/06/10 21:07

Sub test()

　　Dim ws As Worksheet
　　Dim r　As Range

　　With ActiveWorkbook
　　　　Set ws = Worksheets.Add
　　　　With .Sheets("案件一覧（DSG）")
　　　　　　Set r = .Range("W2", .Range("B2").End(xlDown))
　　　　End With
　　　　With .PivotCaches.Add(SourceType:=xlDatabase, _
　　　　　　　　　　　　　　　SourceData:=r.Address(external:=True))
　　　　　　With .CreatePivotTable(TableDestination:=ws.Range("A1"))
　　　　　　　　.AddFields RowFields:="製品区分"
　　　　　　　　With .PivotFields("見込" & Chr(10) & "受注金額")
　　　　　　　　　　.Orientation = xlDataField
　　　　　　　　　　.Caption = "合計 : 金額"
　　　　　　　　　　.Function = xlSum
　　　　　　　　End With
　　　　　　End With
　　　　　　With .CreatePivotTable(TableDestination:=ws.Range("D1"))
　　　　　　　　.AddFields RowFields:="製品区分"
　　　　　　　　With .PivotFields("見込" & Chr(10) & "受注金額")
　　　　　　　　　　.Orientation = xlDataField
　　　　　　　　　　.Caption = "合計 : 金額"
　　　　　　　　　　.Function = xlSum
　　　　　　　　End With
　　　　　　End With
　　　　　　With .CreatePivotTable(TableDestination:=ws.Range("H1"))
　　　　　　　　.AddFields RowFields:="製品区分"
　　　　　　　　With .PivotFields("見込" & Chr(10) & "受注金額")
　　　　　　　　　　.Orientation = xlDataField
　　　　　　　　　　.Caption = "合計 : 金額"
　　　　　　　　　　.Function = xlSum
　　　　　　　　End With
　　　　　　End With
　　　　End With
　　End With

　　Set r = Nothing
　　Set ws = Nothing
End Sub

一例としてはこんな感じです。
PivotCachesをまず追加して、同じPivotCacheからCreatePivotTableを繰り返せば良いです。

この回答へのお礼

とても分かりやすかったです、丁寧な回答ありがとうございました。

ちなみにピポッドテーブルの集計要素が二つ（例：受注見込月と製品区分）の場合の見込受注金額をサマリーするにはどうすればよいのでしょうか？

五月雨式の質問で申し訳ありませんがよろしくお願いします。

お礼日時：2009/06/10 22:31

No.2 回答者： end-u 回答日時： 2009/06/10 23:09

':

With .CreatePivotTable(TableDestination:=ws.Range("A1"))
　　.AddFields RowFields:=Array("受注見込月", "製品区分")
　　'"受注見込月"ごとの集計が不要な場合は次行を非コメント
　　'.RowFields(2).Subtotals(1) = False
　　With .PivotFields("見込" & vbLf & "受注金額")
　　　　.Orientation = xlDataField
　　　　.Caption = "合計 : 金額"
　　　　.Function = xlSum
　　End With
End With
':
こんな感じ。
マクロの自動記録からでもわかると思いますが。

この回答へのお礼

早速のご回答ありがとうございます。

.RowFields(2).Subtotals(1) = False　を

.RowFields(1).Subtotals(1) = False

にしたらうまくいきました。


まことに申し訳ありませんが、最後のお願いです。

受注見込月が複数年にまたがる可能性が出た為、受注年度を用意し、
ピポッドで絞込みをしようと思い、マクロの記録をやって見ました。

With ActiveSheet.PivotTables("ピボットテーブル66").PivotFields("受注年度")
　　　　.Orientation = xlPageField
　　　　.Position = 1
End With

上記を付け加えましたがエラーが解消されず困っています。

お手透きの際にでもご教授よろしくお願いします。

お礼日時：2009/06/11 00:15

No.3 回答者： end-u 回答日時： 2009/06/11 01:19

':

With .CreatePivotTable(TableDestination:=ws.Range("A1"))
　　.AddFields RowFields:=Array("受注見込月", "製品区分"), _
　　　　　　　 PageFields:="受注年度"
　　.RowFields("受注見込月").Subtotals(1) = False
　　With .PivotFields("見込" & vbLf & "受注金額")
　　　　.Orientation = xlDataField
　　　　.Caption = "合計 : 金額"
　　　　.Function = xlSum
　　End With
End With
':
ヘルプも活用して、コードの意味を理解し、基本から押さえたほうが良いですよ。

#Office系ソフトカテゴリへマルチポストになっています。削除依頼を出しておいてください。

この回答へのお礼

多々ご教授ありがとうございました。

お陰で予定より早く作業の目処がたちました。昨日VBAの書籍を購入
しましたのでこれから基本を勉強してみます。

多重投稿は削除しておきました。

不慣れなものでご迷惑をおかけして申し訳ありません。

ありがとうございました。

お礼日時：2009/06/11 12:21