Créer un TCD par Macro sur chaque onglet

Bonjour à tous

Mon fichier excel est strucuré de la manière suivante :

• sur le 1er onglet il y a un tableau en dur avec à côté un bouton de macro pour générer un Tableau croisé dynamique.
• et beaucoup d'autre onglet avec un tableau en dur mais je ne connais pas la façon de répéter cette fonctionnalité pour générer facilement un TCD sur chaque onglet.

Merci de votre aide

@ bientôt

Des suggestions ?

Bonjour,

Une suggestion, oui

Pour commencer, envoie ton fichier anonymisé ou le code VBA pour la construction de ton premier TCD.

Cdlt.

Alors, voici une partie de ma macro. Les zones jaunes surlignées sont celles que je souhaite modifier avec une boucle itérative.

Sub tcd()

'

' tcd Macro

'

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"Expenses Cop NJ MPS!R17C1:R228C13", Version:=xlPivotTableVersion14). _

CreatePivotTable TableDestination:="Expenses Cop NJ MPS!R17C18", TableName _

:="PivotTable2", DefaultVersion:=xlPivotTableVersion14

Sheets("Expenses Cop NJ MPS").Select

Cells(17, 18).Select

ActiveWorkbook.ShowPivotTableFieldList = True

With ActiveSheet.PivotTables("PivotTable2").PivotFields("name project/activity" _

)

.Orientation = xlRowField

.Position = 1

End With

With ActiveSheet.PivotTables("PivotTable2").PivotFields("type of cost")

.Orientation = xlRowField

.Position = 2

End With

With ActiveSheet.PivotTables("PivotTable2").PivotFields("AXA GS SAS")

.Orientation = xlRowField

.Position = 3

End With

With ActiveSheet.PivotTables("PivotTable2").PivotFields("Internals")

.Orientation = xlRowField

.Position = 4

End With

With ActiveSheet.PivotTables("PivotTable2").PivotFields("Cost Profile")

.Orientation = xlRowField

.Position = 5

End With

Re,

Un peu léger comme explications.

Comment d'onglets à traiter?

La structure des onglets et des plages sont-elles identiques?

Les tableaux sont-ils réellement des tableaux (voir gestionnaire de noms)

Je suppose que tous les TCDs sont identiques sauf la plage des données source.

Etc...

Envoie ton fichier anonymisé avec 2 feuilles à traiter, pour débuter.

Cdlt.

Bonjour,

Un début de réponse.

Cdlt.

Option Explicit

Public Sub Creer_TCDs()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastCol As Integer, lRow As Integer, ptCount As Integer
Dim ptCache As PivotCache
Dim pt As PivotTable

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
        For Each pt In ws.PivotTables
            pt.TableRange2.Delete
        Next pt
    Next ws

    lRow = 17
    ptCount = 1

    For Each ws In wb.Worksheets
        lastCol = ws.Cells(lRow, Columns.Count).End(xlToLeft).Column
        Set ptCache = wb.PivotCaches.Create(xlDatabase, ws.Cells(lRow, 1).CurrentRegion, 4)
        Set pt = ptCache.CreatePivotTable(ws.Cells(lRow, lastCol + 5), "PT_" & ptCount, , 4)
        pt.ManualUpdate = True
        pt.AddFields _
                RowFields:=Array("name project/activity", "type of cost", "AXA GS SAS", "Internals", "Cost Profile")
        pt.RowAxisLayout xlTabularRow
        pt.ManualUpdate = False
        ptCounter = ptCounter + 1
    Next ws

    Set pt = Nothing
    Set ptCache = Nothing
    Set ws = Nothing
    Set wb = Nothing

End Sub

Bonjour,

merci beaucoup pour votre aide,

je vais essayer le code

@+

Re-bonjour,

Auriez-vous la gentillesse de commenter les lignes de codes pour que je comprennent la création du code, notemment l'expression pt.TableRange2.1 ?

Finalement, je souheterai avoir les tableaux croisés dynamiques qui se génèrent à côté des tableaux de chaque onglet.

La taille des tableaux sera toujours identique.

Cette Macro serait utilisé sur des fichiers pouvant avoir jusqu'à plusieurs dizaines d'onglets.

Dans la pièce jointe vous trouverez, le fichier avec 2 feuilles à traiter même s'il faudrait que la cmacro fonctionne si possible quelque soit le nombe d'onglet.

Merci d'avance

Bonjour,

La structure de tes tableaux ne permet pas l'utilisation de TCDs.

Cdlt.

J'ajoute une précision sur ce fichier,

les colonnes en jaunes apparaîtront dans le tableau croisé dynamique.

Très cordialement

Re,

As-tu lu mon précédent message?

Cdlt.

Bonjour,

excusez-moi, en fait je n'ai pas compris pourquoi la structure de tes tableaux ne permet pas l'utilisation de TCDs.

Bonjour,

Pour créer un TCD, il faut une plage de cellules continues sans colonnes et lignes vides.

Les colonnes comportent un entête.

Cdlt.

oui, mais dans la pièce jointe que j'ai envoyé lorsque je sélectionne la plage A17:L116, puis je fais une insertion de TCD sur la feuille de calcul existante.

En Etiquettes de lignes : je choisis

name projet/activity

type of cost

AXA GS SAS

Internals

En Etiquettes de colonne

Somme Valeurs

En Valeurs

Count of Man days

Count of Amount in Euros

Puis afficher sous forme tabulaire

Donc, si j'ai bien compris la structure du tableau permet l'utilisation de TCD...

@+

Bonjour,

ALT F8 et exécuter Creer_TCDs

ALT F11 pour ouvrir l'éditeur VBE. - Voir Module1.

Ate relire.

Cdlt.

Option Explicit

Public Sub Creer_TCDs()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Integer, lastCol As Integer, lRow As Integer, ptCount As Integer
Dim rngPt As Range
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim pf As PivotField

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
        For Each pt In ws.PivotTables
            pt.TableRange2.Delete
        Next pt
    Next ws

    lRow = 17
    ptCount = 1

    For Each ws In wb.Worksheets

        lastRow = ws.Cells(Rows.Count, "L").End(xlUp).Row
        lastCol = ws.Cells(lRow, Columns.Count).End(xlToLeft).Column

        Set rngPt = ws.Cells(lRow, 1).Resize(lastRow, lastCol)
        Set ptCache = wb.PivotCaches.Create(xlDatabase, rngPt, 4)
        Set pt = ptCache.CreatePivotTable(ws.Cells(lRow, lastCol + 2), "PT_" & ptCount, , 4)

        pt.ManualUpdate = True

        pt.AddFields _
                RowFields:=Array("name project/activity", "type of cost", "AXA GS SAS", "Internals")
        With pt.PivotFields("Man days")
            .Orientation = xlDataField
            .Function = xlCount    'xlsum pour la somme
            .Position = 1
            .NumberFormat = "#,##0"
            .Caption = "Count Man days"
        End With

        With pt.PivotFields("Amount in Euros")
            .Orientation = xlDataField
            .Function = xlCount    'xlsum pour la somme
            .Position = 2
            .NumberFormat = "#,##0.00"
            .Caption = "Count Amount in Euros"
        End With

        On Error Resume Next
        For Each pf In pt.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf
        On Error GoTo 0

        pt.RowAxisLayout xlTabularRow
        pt.ManualUpdate = False
        ptCount = ptCount + 1

    Next ws

    Set pt = Nothing
    Set ptCache = Nothing
    Set rngPt = Nothing
    Set ws = Nothing
    Set wb = Nothing

End Sub

Yes ça marche !!!!

merci beaucoup

félicitations