vba ピボット、円グラフ対応

Function AggregateAndCopyData() As Long
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim sourceRow As Long
    Dim destRow As Long
    Dim sumRow3 As Double
    Dim sumRow6 As Double
    Dim i As Integer

    ' シートの設定
    Set sourceSheet = ThisWorkbook.Sheets("SourceSheetName") ' ソースシートの名前を設定
    Set destinationSheet = ThisWorkbook.Sheets("DestinationSheetName") ' 目的シートの名前を設定

    sourceRow = 1 ' ソースシートの開始行
    destRow = 5   ' 目的シートの開始行

    ' ソースシートをループ処理
    Do While sourceSheet.Cells(sourceRow, 2).Value <> ""
        ' 3行目の合計を計算
        sumRow3 = 0
        For i = 3 To 14 ' C列は3、N列は14に対応
            sumRow3 = sumRow3 + sourceSheet.Cells(sourceRow + 2, i).Value
        Next i

        ' 6行目の合計を計算
        sumRow6 = 0
        For i = 3 To 14
            sumRow6 = sumRow6 + sourceSheet.Cells(sourceRow + 5, i).Value
        Next i

        ' 目的シートにデータをコピー
        destinationSheet.Cells(destRow, 3).Value = sumRow3 ' 3列目に3行目の合計
        destinationSheet.Cells(destRow, 5).Value = sumRow6 ' 5列目に6行目の合計

        ' 次の行に進む
        sourceRow = sourceRow + 8
        destRow = destRow + 1
    Loop
        ' 最後の行の値を返す
    AggregateAndCopyData = destRow - 1
End Function

Sub CreatePivotTable(destinationSheet As Worksheet, dataRange As Range)
    Dim pivotTable As pivotTable

    ' ピボットテーブルの作成
    Set pivotTable = destinationSheet.PivotTables.Add( _
        PivotCache:=ThisWorkbook.PivotCaches.Create( _
            SourceType:=xlDatabase, _
            SourceData:=dataRange), _
        TableDestination:=destinationSheet.Range("K3"), _
        tableName:="PivotTable1")

    ' ピボットテーブルの設定
    With pivotTable
        .PivotFields("項目名").Orientation = xlRowField
        .PivotFields("合計").Orientation = xlDataField
    End With
End Sub

Sub CreateChart(chartSheet As Worksheet, pivotTable As pivotTable)
    Dim chart As chart
    Dim pivotRange As Range

    ' ピボットテーブルの範囲を取得
    Set pivotRange = pivotTable.TableRange2

    ' 円グラフの作成
    Set chart = chartSheet.Shapes.AddChart2( _
        Style:=5, _
        XlChartType:=xlPie, _
        Left:=100, Top:=100, Width:=375, Height:=225).chart

    ' グラフのデータ範囲を設定
    chart.SetSourceData Source:=pivotRange

    ' その他のグラフ設定
    With chart
        .HasTitle = True
        .ChartTitle.Text = "項目別合計"
        .ApplyDataLabels
    End With
End Sub

Sub DeleteExistingPivotTable(destinationSheet As Worksheet, tableName As String)
    Dim pt As pivotTable

    For Each pt In destinationSheet.PivotTables
        If pt.Name = tableName Then
            pt.TableRange2.Clear
            Exit For
        End If
    Next pt
End Sub

Sub Main()
    Dim lastRow As Long
    Dim destinationSheet As Worksheet
    Dim chartSheet As Worksheet
    Dim dataRange As Range
    Dim pivotTable As pivotTable

    ' シートの設定
    Set destinationSheet = ThisWorkbook.Sheets("DestinationSheetName")
        
    On Error Resume Next
    Set chartSheet = ThisWorkbook.Sheets("ChartSheetName")
    On Error GoTo 0
    If chartSheet Is Nothing Then
        Set chartSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        chartSheet.Name = "ChartSheetName"
    End If

    ' 集計データを取得
    lastRow = AggregateAndCopyData()
    Set dataRange = destinationSheet.Range("B4:C" & lastRow)

    ' 既存のピボットテーブルがあれば削除
    Call DeleteExistingPivotTable(destinationSheet, "PivotTable1")

    ' ピボットテーブルを作成
    Call CreatePivotTable(destinationSheet, dataRange)
    Set pivotTable = destinationSheet.PivotTables("PivotTable1")

    ' 円グラフを作成
    Call CreateChart(chartSheet, pivotTable)
End Sub