ピボットテーブルのマクロでシートを指定、連続

質問

過去問？も確認しましたが、うまく行きません。
マクロの自動記録で作成し、TableDestination:=Sheets("Sheet1").Range("A1"),、と変更しましたが、
With ActiveSheet.PivotTables("ピボットテーブル1")のところで止まってしまいます。また、最後の行の
Application.Run "'Pivot for 東京.xls'!Macro3"は、正しい記述でしょうか？
　よろしくお願いします。

Workbooks.Open Filename:= _
"C:\Documents and Settings\　\デスクトップ\Access DB\Pivot for 東京.xls"
Sheets("DSG").Select
Columns("A:AZ").Select
Range("Q1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("GSG").Select
Columns("A:AZ").Select
Range("P1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("ダート").Select
Columns("A:AZ").Select
Range("W1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("芝").Select
Columns("A:AZ").Select
Range("AQ1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Windows("Pivot01.xls").Activate
Sheets("G").Select
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"G!R1C5:R8594C11").CreatePivotTable TableDestination:=Sheets("Sheet1").Range("A1"), TableName _
:="ピボットテーブル1"
With ActiveSheet.PivotTables("ピボットテーブル1")　　'------------＞ここで止まります
.NullString = "0"
.SmallGrid = False
End With
ActiveSheet.PivotTables("ピボットテーブル1").AddFields RowFields:="騎手名", _
ColumnFields:=Array("距離", "着順")
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("着順")
.Orientation = xlDataField
.Caption = "データの個数 : 着順"
.Function = xlCount
End With
Application.CommandBars("PivotTable").Visible = False
Windows("Pivot01.xls").Activate

Sheets("1").Select
Columns("A:DD").Select
Selection.Delete Shift:=xlToLeft

Sheets("D").Select
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"D!R1C5:R9508C11").CreatePivotTable TableDestination:=Sheets("Sheet1").Range("A1"), TableName _
:="ピボットテーブル2"
ActiveSheet.PivotTables("ピボットテーブル2").SmallGrid = False
ActiveSheet.PivotTables("ピボットテーブル2").AddFields RowFields:="騎手名", _
ColumnFields:=Array("距離", "着順")
With ActiveSheet.PivotTables("ピボットテーブル2").PivotFields("着順")
.Orientation = xlDataField
.Caption = "データの個数 : 着順"
.Function = xlCount
End With
Application.CommandBars("PivotTable").Visible = False
Windows("Pivot01.xls").Activate

Sheets("1").Select
Columns("A:DD").Select
Selection.Delete Shift:=xlToLeft

Sheets("GSG").Select
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"GSG!R1C5:R81C11").CreatePivotTable TableDestination:=Sheets("Sheet1").Range("A1"), TableName _
:="ピボットテーブル3"
With ActiveSheet.PivotTables("ピボットテーブル3")
.NullString = "0"
.SmallGrid = False
End With
ActiveSheet.PivotTables("ピボットテーブル3").AddFields RowFields:="騎手名", _
ColumnFields:="着順"
With ActiveSheet.PivotTables("ピボットテーブル3").PivotFields("着順")
.Orientation = xlDataField
.Caption = "データの個数 : 着順"
.Function = xlCount
End With
Application.CommandBars("PivotTable").Visible = False
Windows("Pivot01.xls").Activate

Application.Run "'Pivot for 東京.xls'!Macro3"
End Sub

回答No.4

end-u · ベストアンサー

単純に４つつなげて、かつ新規シートにピボットを作成するだけなら以下。
Sub try02()
　　Dim pt　As PivotTable 'ピボットテーブル用変数を準備
　　Dim rng As Range　　　'データ範囲用変数を準備

　　Application.ScreenUpdating = False
　　'マクロがあるBookなら『 With ThisWorkbook 』 でも可
　　With ThisWorkbook 'Workbooks("Pivot01.xls")
　　　　'----------------------------------------------------------
　　　　'Gシートの E列最終行から K1セルまでの矩形範囲がデータ範囲？
　　　　With .Sheets("G")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　'ピボットテーブルを作成して変数に格納
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　'以下、変数ptを利用してピボットを操作
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:=Array("距離", "着順")
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　　　'----------------------------------------------------------
　　　　With .Sheets("D")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:=Array("距離", "着順")
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　　　'----------------------------------------------------------
　　　　With .Sheets("GSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:="着順"
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　　　'----------------------------------------------------------
　　　　With .Sheets("DSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:="着順"
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　End With
End Sub

出来上がりの形がわからないので参考ですが
サブプロシージャを使ってまとめると以下のような感じです。
Sheet1にまとめて作成します。

Sub try03()
　　Dim pt　As PivotTable
　　Dim rng As Range

　　Application.ScreenUpdating = False
　　With ThisWorkbook 'Workbooks("Pivot01.xls")
　　　　.Sheets("Sheet1").UsedRange.Clear
　　　　With .Sheets("G")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("距離", "着順"), "着順")
　　　　With .Sheets("D")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("距離", "着順"), "着順")
　　　　With .Sheets("GSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("着順"), "着順")
　　　　With .Sheets("DSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("着順"), "着順")
　　End With
End Sub

Sub SubPivot(rng As Range, r, c, f As String)
　　Dim dest As Range

　　With ThisWorkbook
　　　　With .Sheets("Sheet1")
　　　　　　Set dest = .Cells(.Rows.Count, 1).End(xlUp).Offset(2)
　　　　End With
　　　　With .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　.CreatePivotTable(TableDestination:=dest)
　　　　　　.NullString = "0"
　　　　　　.AddFields RowFields:=r, _
　　　　　　　　　　　 ColumnFields:=c
　　　　　　With .PivotFields(f)
　　　　　　　　.Orientation = xlDataField
　　　　　　　　.Function = xlCount
　　　　　　End With
　　　　End With
　　End With
End Sub

お礼

何度もありがとうございました。
マクロの理解は追いつきませんでしたが、作動は完璧です。
少しずつ勉強していきます。

回答No.3

end-u

>以下が黄色くなって「プロパティを取得できません」となります。
だから、
『この時のActiveSheetが何か考えてみましょう。』って書いてるでしょ。
同じ事です。

冒頭の"Pivot for 東京.xls"の列削除は別として、
>Windows("Pivot01.xls").Activate
>Sheets("G").Select
>Range("E1").Select
>Range(Selection, Selection.End(xlDown)).Select
>Range(Selection, Selection.End(xlToRight)).Select
>ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
>"G!R1C5:R8594C11").CreatePivotTable TableDestination:=Sheets("Sheet1").Range("A1"), TableName _
>:="ピボットテーブル1"
>With ActiveSheet.PivotTables("ピボットテーブル1")　　'------------＞ここで止まります
>.NullString = "0"
>.SmallGrid = False
>End With
>ActiveSheet.PivotTables("ピボットテーブル1").AddFields RowFields:="騎手名", _
>ColumnFields:=Array("距離", "着順")
>With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("着順")
>.Orientation = xlDataField
>.Caption = "データの個数 : 着順"
>.Function = xlCount
>End With
>Application.CommandBars("PivotTable").Visible = False
>Windows("Pivot01.xls").Activate

以上の箇所を整理すると
Sub try01()
　　Dim pt　As PivotTable 'ピボットテーブル用変数を準備
　　Dim rng As Range　　　'データ範囲用変数を準備

　　'マクロがあるBookなら『 With ThisWorkbook 』 でも可
　　With Workbooks("Pivot01.xls")
　　　　'Gシートの E列最終行から K1セルまでの矩形範囲がデータ範囲？
　　　　With .Sheets("G")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With

　　　　'ピボットテーブルを作成して変数に格納
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Sheets("Sheet1").Range("A1"))

　　　　'以下、変数ptを利用してピボットを操作
　　　　pt.NullString = "0"
　　　　pt.SmallGrid = False
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:=Array("距離", "着順")
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Caption = "データの個数 : 着順"
　　　　　　.Function = xlCount
　　　　End With
　　End With
　　Application.CommandBars("PivotTable").Visible = False
End Sub

..こんな感じになります。
『応用』してくださいね。

それと提示コードでは３つのピボットテーブルを
Sheets("Sheet1").Range("A1")に作成するようになってますけど
既存のピボットテーブルがある位置に上書き作成はできないですから。
連続実行するわけではないと思いますが、そこも『応用』してください。

お礼

御回答ありがとうございます。
1度は、作動するのですが、連続で使用すると以下で止まります。
ptとrngをpt2とrng2　のように変更したり、教えていただいたサイトを見て勉強したのですが分かりませんでした。
　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Sheets("Sheet1").Range("A1"))

SheetGとSheetDとSheetGSGとSheetDSGの4つのシートのデータをピボットテーブルで処理したいのです。
SheetGのデータをピボットテーブルでSheet1に処理し、別のファイルに貼り付け、
Sheet1を Cells.Select　Selection.Clear と削除して
SheetDのデータをピボットテーブルでSheet1に処理し、別のファイルに貼り付け.....としようとしたのですが、いろいろと試行錯誤したのですが、分かりませんでした。再度御教示いただけないでしょうか、よろしくお願い致します。

回答No.2

end-u

>With ActiveSheet.PivotTables("ピボットテーブル1") '------------＞ここで止まります
なのでエラーメッセージは
『実行時エラー '1004':　Worksheet クラスの PivotTables プロパティを取得できません。』
なのでしょう。
この時のActiveSheetが何か考えてみましょう。
７行前に
>Sheets("G").Select
していますからSheets("G")がActiveになっています。
>..TableDestination:=Sheets("Sheet1").Range("A1"),..
PivotTables("ピボットテーブル1")があるのは指定したSheets("Sheet1")であって
Sheets("G")ではないですからエラーになります。
With Sheets("Sheet1").PivotTables(1)
..のように指定してあげれば良いでしょう。

マクロ記録ではSelectやActiveSheetをベースにしたコードになりますから
実際にはSelectやActivateに頼らない記述を意識して修正したほうが良いです。
（参考サイトです）
http://pvttbl.blog23.fc2.com/
http://pvttbl.blog23.fc2.com/blog-category-3.html

>..また、最後の行の
>Application.Run "'Pivot for 東京.xls'!Macro3"は、正しい記述でしょうか？
Application.Runメソッドで
「Pivot for 東京.xls」ブックに書かれた「Macro3」マクロを実行します。
マクロ記録時に他のマクロを実行すればそれも記録されます。
必要なければ削除して構いません。

お礼

御回答ありがとうございます。
'With ActiveSheet.PivotTables("ピボットテーブル1") '------------＞ここで止まります
を
With Sheets("Sheet1").PivotTables(1)
に変えたところ、次の3行は進むのですが、
.NullString = "0"
.SmallGrid = False
End With

以下が黄色くなって「プロパティを取得できません」となります。
("ピボットテーブル1"）をPivotTables(1)に変えても同じところで止まります。
引き続き教えていただけないでしょうか。
ActiveSheet.PivotTables("ピボットテーブル1").AddFields RowFields:="騎手名", _
ColumnFields:=Array("距離", "着順")

回答No.1

tsubuyuki

えーと。
そこで止まるのはわかりました。
その際、「どんなエラーメッセージが」出てきますか？
それがわからないと対処法も特定できません。
（まぁ、ピボットテーブル作成時点でのエラーですからある程度の予測はできますが。）

エラーメッセージは
「インデックスが有効範囲にありません」
ではないでしょうか。
という前提で話を進めます。

コレは主に「指定されたワークシートがありません」な時に発生するエラーです。
なので、今回は（おそらく）
> TableDestination:=Sheets("Sheet1").Range("A1")
でピボットテーブル作成先に指定している「Sheet1」が存在しないもの、と思われます。

対処としては「作成先シートを“存在するシート名”に変えてやる」
あるいは「前段で"Sheet1"シートを作ってやる」のどちらかです。

> Application.Run "'Pivot for 東京.xls'!Macro3"は、正しい記述でしょうか？
キチンと動けば、正しいコードです。
そのブックが開いている状態なら、おそらく動きます。
その他、現状のコードに見ても（おそらく）マクロの記録そのままでしょう。
だとすると、動かないほうがおかしい、とも言えます。

「記録」を見やすく汎用的に書き直す方法は色々ありますが、
本件とは直接のかかわりがありませんから、細かい添削は遠慮しておきます。
別途、研究なさって下さいませ。