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

質問

今ボタンを押下すると自動的にピポッドテーブルを作成するマクロを作成しています。
【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 · ベストアンサー

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を繰り返せば良いです。

お礼

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

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

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

回答No.3

end-u

':
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の書籍を購入
しましたのでこれから基本を勉強してみます。

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

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

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

回答No.2

end-u

':
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

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

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