Créé un PivotChart

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
Rechercher des sujets similaires à "cree pivotchart"