ピポットテーブルウィーザードを用いてピポットテーブル作成時にマクロの自動記録を実行し以下が記録されました。データの範囲を列方向と行方向のデータの終りまでに設定するにはどのように書きなおせばいいかご教示いただければ幸いです。

●「データの終りまで」というのが曲者で、excelにはデータの終わりを取得する方法がいくつかあります。

「A列に入力されている最後の行」を取得するのがwindofjulyさんの方法です。

【参考】

http://www.niji.or.jp/home/toru/notes/8.html で記述されている「書式付きセルを除外する」方法でサンプルを書いてみました。

●もうひとつ引っかかるのが、pivotテーブルを何回も書いていると、テーブル名が重複して、エラーになるケースがあります。ので、テーブル名を"ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1"として、存在すれば、削除するようにしました。

●割とよくありがちなVBAの失敗として、Selectionとか、ActiveBook,ActieSheetとかを使うと、デバッグしているときにSelectionが変わってしまって、わけがわからない動きになることがあります。ので、Active~を最小にしました。

Sub ピポットテーブル作成()
    Dim book As Workbook
    Set book = ActiveWorkbook
    Dim dataSheet As Worksheet
    Dim pivotSheet As Worksheet
    Set dataSheet = book.Worksheets("main") ' データシート名はmainです
    Set pivotSheet = book.Worksheets("pivot") ' ピボットテーブルを作るシートはpivotです
    
    '最大行、最大列を求める
    Dim maxRow As Long
    Dim maxCol As Long
    With dataSheet.UsedRange
        maxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).row
        maxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With
    Dim area As Range
    Set area = dataSheet.Range( _
        dataSheet.Cells(1, 1), _
        dataSheet.Cells(maxRow, maxCol))
    
    ' ピボットテーブル名
    Dim pivotName As String
    pivotName = "ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1"
    Call removePivot(pivotSheet, pivotName)
    
    book.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=area) _
        .CreatePivotTable _
            TableDestination:=pivotSheet.Range("A3"), _
            TableName:=pivotName, _
            DefaultVersion:=xlPivotTableVersion10
    book.ShowPivotTableFieldList = True
    With pivotSheet.PivotTables(pivotName).PivotFields("仕入先")
        .Orientation = xlRowField
        .Position = 1
    End With
    With pivotSheet.PivotTables(pivotName).PivotFields("支払月")
        .Orientation = xlColumnField
        .Position = 1
    End With
    pivotSheet.PivotTables(pivotName).AddDataField _
        pivotSheet.PivotTables(pivotName).PivotFields("支払い額"), "合計 / 支払い額", xlSum
    book.ShowPivotTableFieldList = False
End Sub
' 既存のピボットテーブルを削除
Private Sub removePivot(pivotSheet As Worksheet, pivotName)
    On Error GoTo OnError
    pivotSheet.PivotTables(pivotName).PivotSelect "", xlDataAndLabel, True
    Selection.ClearContents
OnError:
    ' 存在しなければエラーになります
End Sub