问同一工作表中的VBA -Place透视表

EN

Sub Macro4()

Dim FinalRow            As Long
Dim DataSheet           As String
Dim PvtCache            As PivotCache
Dim PvtTbl              As PivotTable
Dim DataRng             As Range
Dim TableDest           As Range

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = ActiveSheet.Name

' set data range for Pivot Table
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 8))  ' conversion of R1C1:R & FinalRow & C8

' set range for Pivot table placement
Set TableDest = Sheets(DataSheet).Cells(1, 9)  ' conversion of R1C9

Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)

' this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables("PivotTable4") ' check if "PivotTable4" Pivot Table already created (in past runs of this Macro)

On Error GoTo 0
If PvtTbl Is Nothing Then ' "PivotTable4" doesn't exist >> create it

    ' create a new Pivot Table in "PivotTable4" sheet
    Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:="PivotTable4")

    With PvtTbl.PivotFields("Document Type")
        .Orientation = xlRowField
        .Position = 1
    End With

    With PvtTbl.PivotFields("Accounting Event")
        .Orientation = xlRowField
        .Position = 2
    End With

    With PvtTbl.PivotFields("Document Number")
        .Orientation = xlRowField
        .Position = 3
    End With

    PvtTbl.AddDataField ActiveSheet.PivotTables( _
    "PivotTable4").PivotFields("Amount"), "Sum of Amount", xlSum

Else
    ' just refresh the Pivot cache with the updated Range
    PvtTbl.ChangePivotCache PvtCache
    PvtTbl.RefreshTable
End If


End Sub