ピポットテーブルの作成

ピポットテーブルはデータ分析ツールとしてエクセルでよく使われる作業です。
改良されて使いやすくなっていますが、データが追加になった場合は選択範囲を変更しなければなりません。
条件を入力して定型業務として使う場合はVBAで作らないと面倒です。

Sub 項目1つ()
    Dim i As Long
    Dim j As Long
    Dim lastrow As Long
    Dim kei As Long
'dataを作業シートへコピー
    Worksheets("作業").Cells.Clear
    Worksheets("作業").Select
    lastrow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastrow
        For j = 1 To 2
            Worksheets("作業").Cells(i, j) = Worksheets("data").Cells(i, j)
        Next
    Next
'作業シートを１列目コードで並び替える
    Worksheets("作業").Activate
    Range(Cells(2, 1), Cells(lastrow, 2)).Select
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _
    :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("作業").Sort
    .SetRange Range(Cells(2, 1), Cells(lastrow, 2))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
'ピポット作成コード計を作業1に取り出す
    Worksheets("作業1").Cells.Clear
    Worksheets("作業1").Cells(1, 1) = "コード"
    Worksheets("作業1").Cells(1, 2) = "金額"
    j = 2
    kei = 0
    For i = 2 To lastrow
        kei = kei + Worksheets("作業").Cells(i, 2)
        If Worksheets("作業").Cells(i, 1) <> Worksheets("作業").Cells(i + 1, 1) Then
            Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
            Worksheets("作業1").Cells(j, 2) = kei
            j = j + 1
            kei = 0
        End If
    Next
    Worksheets("作業1").Select

Sub 項目2つ()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim kei As Long
    Dim retu As Long
    Dim lastrow As Long
    Dim lastrow1 As Long
'data1作業シートへコピー
    Worksheets("作業").Cells.Clear
    lastrow = Worksheets("data1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastrow
        For j = 1 To 3
            Worksheets("作業").Cells(i, j) = Worksheets("data1").Cells(i, j)
        Next
    Next
    Worksheets("作業").Select
'作業シートを１列目コードと２列目コードで並び替える
    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("作業").Activate
    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    Range(Cells(2, 1), Cells(lastrow, 3)).Select
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _
    :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 2), SortOn _
    :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("作業").Sort
    .SetRange Range(Cells(2, 1), Cells(lastrow, 3))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
'コードと区分で集計して作業1に取り出す（データ集計作業1完了）
    Worksheets("作業1").Cells(1, 1) = "コード"
    Worksheets("作業1").Cells(1, 2) = "区分"
    Worksheets("作業1").Cells(1, 3) = "金額"
   k = 2
    kei = 0
    For i = 2 To lastrow
        kei = kei + Worksheets("作業").Cells(i, 3)
        If Worksheets("作業").Cells(i, 1) <> Worksheets("作業").Cells(i + 1, 1) Or Worksheets("作業").Cells(i, 2) <> Worksheets("作業").Cells(i + 1, 2) Then
           Worksheets("作業1").Cells(k, 1) = Worksheets("作業").Cells(i, 1)
           Worksheets("作業1").Cells(k, 2) = Worksheets("作業").Cells(i, 2)
           Worksheets("作業1").Cells(k, 3) = kei
           k = k + 1
           kei = 0
        End If
    Next
'２次元の集計表を作成する
'作業の区分を並び替える（列項目を作り出すための準備）
    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("作業").Activate
    Range(Cells(2, 1), Cells(lastrow, 2)).Select
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 2), SortOn _
    :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("作業").Sort
    .SetRange Range(Cells(2, 1), Cells(lastrow, 2))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
'作業から区分を取り出す重複をなくす作業2に作成（列項目を作り出す作業2の行にできている）
    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("作業2").Cells.Clear
    Worksheets("作業2").Cells(1, 1) = "区分"
    k = 2
    For i = 2 To lastrow
        If Worksheets("作業").Cells(i, 2) <> Worksheets("作業").Cells(i + 1, 2) Then
           Worksheets("作業2").Cells(k, 1) = Worksheets("作業").Cells(i, 2)
           k = k + 1
        End If
    Next
    Worksheets("作業2").Select
'作業2の区分の項目を作業に列に転記（２次元の集計表列項目が作業に完成）
    Worksheets("作業").Cells.Clear
    lastrow = Worksheets("作業2").Cells(Rows.Count, 1).End(xlUp).Row
    k = 2
    For i = 2 To lastrow
        Worksheets("作業").Cells(1, k) = Worksheets("作業2").Cells(i, 1)
        k = k + 1
    Next
    retu = k - 1
'作業1からコードを取り出す重複をなくしながら作業に作成（２次元の集計表行項目が作業に完成）
    lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
    k = 2
    For i = 2 To lastrow
        If Worksheets("作業1").Cells(i, 1) <> Worksheets("作業1").Cells(i + 1, 1) Then
           Worksheets("作業").Cells(k, 1) = Worksheets("作業1").Cells(i, 1)
           k = k + 1
        End If
    Next
'作業1（コード・区分で集計したシート）を作業に転記（金額の入った２次元の集計表が作業に完成）
    lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
    lastrow1 = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
        For j = 2 To lastrow1
            If Worksheets("作業1").Cells(i, 1) = Worksheets("作業").Cells(j, 1) Then
               For k = 2 To retu
                    If Worksheets("作業1").Cells(i, 2) = Worksheets("作業").Cells(1, k) Then
                       Worksheets("作業").Cells(j, k) = Worksheets("作業1").Cells(i, 3)
                       Exit For
                    End If
                Next
                Exit For
            End If
        Next
    Next
'合計の計算
    Worksheets("作業").Cells(lastrow1 + 1, 1) = "合計"
    Worksheets("作業").Cells(1, retu + 1) = "合計"
'列計
    For j = 2 To retu
        For i = 2 To lastrow1
            kei = kei + Worksheets("作業").Cells(i, j)
        Next
        Worksheets("作業").Cells(lastrow1 + 1, j) = kei
        kei = 0
    Next
'行計
    For i = 2 To lastrow1
        For j = 2 To retu
            kei = kei + Worksheets("作業").Cells(i, j)
        Next
        Worksheets("作業").Cells(i, retu + 1) = kei
        kei = 0
    Next
'総計
    For i = 2 To lastrow1
        kei = kei + Worksheets("作業").Cells(i, retu + 1)
    Next
    Worksheets("作業").Cells(lastrow1 + 1, retu + 1) = kei
    Worksheets("作業").Select
End Sub