Extraction de chaque étiquette de ligne dans un tableau croisé dynamique par macro

[Copacobana]

Bonjour à tous,

Cela fait plusieurs jours que je bloque sur un problème pour une macro associée à un tableau croisé dynamique. Etant débutant en macro, je n'arrive pas à créer un code pertinent.
Pour faire court, je souhaite:

- Afficher la première étiquette de ligne
- Copier et coller dans une colonne vide cette partie du tcd
- Faire la même chose pour la deuxième étiquette de ligne
et ainsi de suite

Mon problème est la loop: comment passer automatiquement d'un Pivot Item visible à un autre?

Si quelqu'un a une idée... Ca pourrait me sauver la vie ^^

Merci d'avance!

Vous trouverez ci-joint un extrait du fichier. L'idée est de faire automatiquement l'opération faite sur la feuille 3...

Vince.

 

[MichD]

Re : Extraction de chaque étiquette de ligne dans un tableau croisé dynamique par mac

Bonjour,

Je ne suis pas sûr de ce que tu désires...

Ceci devrait te donner la liste des étiquettes de lignes présente dans le TDC

'--------------------------------------------------

Sub test()
Dim Pt As PivotTable
Dim A As Integer

Set Pt = Worksheets("Feuil1").PivotTables(1)
For A = 1 To Pt.RowFields.Count
    MsgBox Pt.RowFields(A).Name
Next

End Sub

'--------------------------------------------------

Ceci devrait te donner la liste des étiquettes des données présente dans le TDC

Sub test1()
Dim Pt As PivotTable
Dim A As Integer

Set Pt = Worksheets("Feuil1").PivotTables(1)
For A = 1 To Pt.DataFields.Count
    MsgBox Pt.DataFields(A).Name
    Next
End Sub

'--------------------------------------------------

 

[Copacobana]

Re : Extraction de chaque étiquette de ligne dans un tableau croisé dynamique par mac

Hey,
Merci pour ta réponse, mais ce n'est pas cela que je recherche.
Je cherche à automatiser un "copier-coller" d'un tableau croisé dynamique pour chaque étiquette de ligne.
A savoir, de copier coller le tcd qui n'affiche que l'étiquette de ligne 1 puis copier coller le tcd qui n'affiche que l'étiquette de ligne 2... jusqu'à la fin du tableau.

En ce moment, j'ai une macro très incomplète:

Sub pilot ()

With ActivateSheet.PivotTables("PivotTable1").PivotFields("Item")
.PivotItems("2").Visible = True
End With
With ActivateSheet.PivotTables("PivotTable1").PivotFields("Item")
.PivotItems("1").Visible = False
End With

ActiveSheet.PivotTables("PivotTable1").PivotSelect " ",xlDataAndLabel, True
Selection.Copy
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False

End Sub


Actuellement je change manuellement le numéro des lignes: PivotItems("2").Visible = True et PivotItems("1").Visible = False


Je suis donc à la recherche d'automatiser le changement de numéro de PivotItems
De même je souhaiterais copier cela automatiquement 4 colonnes plus loin à chaque fois

 

[Compte Supprimé 979]

Re : Extraction de chaque étiquette de ligne dans un tableau croisé dynamique par mac

Bonjour Copacabana, Salut MichD

Hey,
Merci pour ta réponse, mais ce n'est pas cela que je recherche

Effectivement, MichD aurait dû mieux lire ta question, qui me parait claire 😉

Voici le code

Sub CopierPivotUnParUn()
  Dim Inc As Integer, NCol As Long
  ' Effacer tous les filtres
  ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Item").ClearAllFilters
  ' Masquer toutes les valeurs
  On Error Resume Next
  For Inc = 1 To 231
    With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Item")
      ' Laisser le premier pivot
      If Inc > 1 Then .PivotItems(Inc).Visible = False
    End With
  Next Inc
  ' Copier / coller les donner dans la prochaine colonne vide
  NCol = Cells(4, Columns.Count).End(xlToLeft).Column + 1
  ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotSelect 1, xlDataAndLabel, True
  Selection.Copy
  Cells(3, NCol).PasteSpecial Paste:=xlPasteValues
  ' Pour les pivots suivants
  For Inc = 2 To 231
    With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Item")
      ' Afficher pivot suivant
      .PivotItems(Inc).Visible = True
      ' Masquer le pivot précédent
      .PivotItems(Inc - 1).Visible = False
    End With
    ' Copier / coller les donner dans la prochaine colonne vide
    NCol = Cells(4, Columns.Count).End(xlToLeft).Column + 1
    ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotSelect Inc, xlDataAndLabel, True
    Selection.Copy
    Cells(3, NCol).PasteSpecial Paste:=xlPasteValues
  Next Inc
End Sub

A+

 

[Copacobana]

Re : Extraction de chaque étiquette de ligne dans un tableau croisé dynamique par mac

Super!!!

Merci beaucoup Bruno, c'est exactement ce que je cherchais!!!

 

[Copacobana]

Re : Extraction de chaque étiquette de ligne dans un tableau croisé dynamique par mac

Oups, j'ai parlé trop vite.

Il y a juste un petit problème avec la macro qui ne sait pas prendre en compte un Pivot item qui n'existe pas.
Or comme l' "item" 13 n'existe pas, la macro continue à copier coller l'item 12 mais ne peut passer à l'item 14.

Y aurait-il une solution pour dire "si PivotItem(Inc) n'existe pas alors passer au suivant" ?

For Inc = 2 To 231
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Item")
' Afficher pivot suivant
.PivotItems(Inc).Visible = True
' Masquer le pivot précédent
.PivotItems(Inc - 1).Visible = False