VBA Сводная таблица

Sub PivotTable()

Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim LR As Long
Dim LC As Long

On Error Resume NextError Resume NextVBA On Error Resume Statement is an error-handling aspect used for ignoring the code line because of which the error occurred and continuing with the next line right after the code line with the error.read more
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("Pivot Sheet").Delete 'This will delete the exisiting pivot table worksheet
Worksheets.Add After:=ActiveSheet ' This will add new worksheet

ActiveSheet.Name = "Pivot Sheet" ' This will rename the worksheet as "Pivot Sheet"
On Error GoTo 0

Set PSheet = Worksheets("Pivot Sheet")
Set DSheet = Worksheets("Data Sheet")

'Find Last used row and column in data sheet
LR = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LC = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column

'Set the pivot table data range
Set PRange = DSheet.Cells(1, 1).Resize(LR, LC)

'Set pivot cahe
Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=PRange)

'Create blank pivot table

Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="Sales_Report")

'Insert country to Row Filed
With PSheet.PivotTables("Sales_Report").PivotFields("Country")
.Orientation = xlRowField
.Position = 1
End With

'Insert Product to Row Filed & position 2
With PSheet.PivotTables("Sales_Report").PivotFields("Product")
.Orientation = xlRowField
.Position = 2
End With

'Insert Segment to Column Filed & position 1
With PSheet.PivotTables("Sales_Report").PivotFields("Segment")
.Orientation = xlColumnField
.Position = 1
End With

'Insert Sales column to the data field
With PSheet.PivotTables("Sales_Report").PivotFields("Sales")
.Orientation = xlDataField
.Position = 1
End With

'Format Pivot Table
PSheet.PivotTables("Sales_Report").ShowTableStyleRowStripes = True
PSheet.PivotTables("Sales_Report").TableStyle2 = "PivotStyleMedium14"

'Show in Tabular form
PSheet.PivotTables("Sales_Report").RowAxisLayout xlTabularRow

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub