ピボットテーブルの範囲を可変にしたい

質問

ピボットテーブルのマクロを作っています。
「発注データ」というシートの隣に新しいシートを追加し
そこにピボットテーブルを作成するという内容です。
シート名の「発注データ～」と参照範囲「R1C1:R477C8」の部分が毎回変わるため
（列は固定で行数が増減）それに対応した記述にしたいのですが
どのように変えたらいいのでしょうか？
アドバイスよろしくお願いします。

以下マクロ記録で作成してみました。

Sub pivot()

' pivot Macro

Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"発注データ20170202!R1C1:R477C8", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="ピボットテーブル1" _
, DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("課")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("品番")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("製品コード")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("製品名１")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("製品名２")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("棚番号")
.Orientation = xlRowField
.Position = 5
End With
With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("単価")
.Orientation = xlRowField
.Position = 6
End With
ActiveSheet.PivotTables("ピボットテーブル1").AddDataField ActiveSheet.PivotTables( _
"ピボットテーブル1").PivotFields("数量"), "合計 / 数量", xlSum
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("品番").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("製品コード").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("製品名１").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("製品名２").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("箱番").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("単価").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("数量").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("課").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("ピボットテーブル1").RowAxisLayout xlTabularRow
End Sub

回答No.1

tsubu-yuki · ベストアンサー

範囲を変数に代入しちゃうと楽ちんです。
方法はいくつか考えられますので、よく使われると思う２通りを。
状況によって使い分けてくださいませ。

・表全体がピボットテーブルのデータソースの場合（右・下に余白無し）
　Dim myRange As Range
　Set myRange = Worksheets("発注データ20170202").Cells(1, 1).CurrentRegion
・表の一部（Ａ列～Ｇ列くらいまで表があるが、Ａ～Ｃ列しか使わない）の場合
　※ただし、最下行がデータ終端の時に限る
　Dim myRange As Range
　Dim LastRow as long
　LastRow = Cells(Rows.Count, 1).End(xlUp).Row　' 最下行を取得
　Set myRange = Worksheets("Sheet1").Range("A1:C" & LastRow)
ここで代入された変数（myRange）をピボットテーブルに渡す感じです。
・・・あ、失礼。Ａ～Ｃ列は固定でしたね。だったら後者のほうが良いかもですね。

Sub たとえば
Dim PVSh As Worksheet
Dim myRange As Range
Dim LastRow As Long

　　　　' 最下行を取得
　　　　LastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
　　　　' Ａ１～Ｃ最下行の範囲を変数に代入
　　　　Set myRange = Worksheets("Sheet1").Range("A1:C" & LastRow)

　　　　' 蛇足のカレントリージョン
　　　　'Set myRange = Worksheets("Sheet1").Cells(1, 1).CurrentRegion

　　　　' シートを追加して変数に代入
　　　　Set PVSh = Sheets.Add　
　　　　' 以下、ピボットテーブル作成
　　　　ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
　　　　　　　　　　　　　　　　SourceData:=myRange, _
　　　　　　　　　　　　　　　　Version:=xlPivotTableVersion15).CreatePivotTable _
　　　　　　　　　　　　　　　　TableDestination:=PVSh.Cells(3, 1), _
　　　　　　　　　　　　　　　　TableName:="ピボットテーブル1", _
　　　　　　　　　　　　　　　　DefaultVersion:=xlPivotTableVersion15
（以下省略）

こんな感じでできるんじゃないかなぁ、と思いますよ。

お礼

ありがとうございます。
教えて頂いた内容で作り直してみます。