Créé un PivotChart
l
Bonjour
voila j'ai ce code Vba qui me créé des PivotTable dans plusieurs Worksheet mon besoin et et de créé un un graphe pour chaque tableau Merci
Public Sub CreateWorksheets()
Dim wb As Workbook
Dim Ws As Worksheet, wsPT As Worksheet
Dim pt As PivotTable, ptMain As PivotTable, ptn As PivotTable, ptm As PivotTable
Dim pi As PivotItem
Dim modeCalc As XlCalculation
With Application
modeCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Set wb = ThisWorkbook
Set wsPT = ActiveWorkbook.Worksheets("TCD")
For Each Ws In wb.Worksheets
If Ws.Name <> "INDEX" And Ws.Name <> "TCD" Then
Ws.Delete
End If
Next
Application.DisplayAlerts = True
With wsPT
Set ptMain = .PivotTables("PT_1")
Set pt = .PivotTables("PT_2")
Set ptn = .PivotTables("PT_3")
Set ptm = .PivotTables("PT_4")
With ptMain.PageFields(1)
For Each pi In .PivotItems
.CurrentPage = pi.Value
pt.PageFields(1).CurrentPage = pi.Value
Set Ws = wb.Worksheets.Add
With Ws
.Name = pi.Value
.Move After:=wb.Worksheets(Worksheets.Count)
ptMain.TableRange1.Copy Destination:=.Cells(6, 2)
pt.TableRange1.Copy Destination:=.Cells(13, 2)
ptn.TableRange1.Copy Destination:=.Cells(26, 2)
ptm.TableRange1.Copy Destination:=.Cells(36, 2)
End With
Next pi
.CurrentPage = .PivotItems(1).Name
pt.PageFields(1).CurrentPage = pt.PageFields(1).PivotItems(1).Name
End With
.Activate
End With
PageLayout
Set pt = Nothing: Set ptMain = Nothing: Set ptn = Nothing: Set ptm = Nothing
Set Ws = Nothing: Set wsPT = Nothing
Set wb = Nothing
With Application
.Calculation = modeCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub