TCD par macro

[Ophé]

Bonjour le forum,

une dernière demande pour un tableau croisé dynamique,
je souhaite que lorsque je me met sur une feuille par activation de la macro un tableau croisé dynamique s'effectue.

Mon code donne ça :

Sub TCD()
'
' TCD Macro
'

'
Selection.CurrentRegion.Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"JANVIER!L1C1:L362C27", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Feuil2!L3C1", TableName:="Tableau croisé dynamique2", _
DefaultVersion:=xlPivotTableVersion12
Sheets("Feuil2").Select
Cells(3, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Stat ")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Tableau croisé dynamique2").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique2").PivotFields("Ventes "), _
"Somme de Ventes ", xlSum
ActiveSheet.PivotTables("Tableau croisé dynamique2").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique2").PivotFields("LivrÚe "), _
"Somme de LivrÚe ", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False
ActiveWindow.SmallScroll Down:=0
End Sub

Mon problème est que il n'accepte que pour une feuille donnée (données colorées), je voudrais que ce même TCD se fasse quelque soit la feuille.

Avez-vous une solution??
Merci d'avance.

Ophé

 

[Minick]

Re : TCD par macro

re,

Quelques commentaires en bonus
et en rouge la ligne ajoutee pour les champs de donnees.
Pour la mise en page, je ne sais pas, je n'ai pas 2007.

Option Explicit

Sub TCD()
    Dim ShtSrc As Worksheet, ShtDst As Worksheet
    
    Application.ScreenUpdating = False
        Set ShtSrc = ActiveSheet ' "Memorisation" de la feuille active
        
        If ShtSrc.Range("A65536").End(xlUp).Row > 1 Then ' Verification qu'il y a des donnees dans la feuille active
            ' Suppression de l'ancien TCD pour le mois, si il existe deja
            On Error Resume Next
                Application.DisplayAlerts = False
                ThisWorkbook.Sheets("TCD " & ShtSrc.Name).Delete
                Application.DisplayAlerts = True
            On Error GoTo 0
            
            Set ShtDst = Sheets.Add ' Ajout d'une feuille pour le TCD
            ShtDst.Name = "TCD " & ShtSrc.Name ' Nommage de la feuille en ajoutant le mois
            
            'Creation du TCD
            ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
                "'" & ShtSrc.Name & "'!" & ShtSrc.UsedRange.Address).CreatePivotTable TableDestination:="'" & ShtDst.Name & "'!R1C1", TableName:="TCD " & ShtSrc.Name, DefaultVersion:=xlPivotTableVersion10
            With ShtDst.PivotTables(ShtDst.Name)
                .PivotFields("Stat ").Orientation = xlRowField ' mise en ligne du champ Stat
                
                 ' ajout des champs de donnees
                .AddDataField .PivotFields("Ventes        "), "Somme de Ventes", xlSum
                .AddDataField .PivotFields("LivrÚe       "), "Somme de Livrée", xlSum
                [COLOR=Red].DataPivotField.Orientation = xlColumnField[/COLOR] ' mise en colonne des champs de donnees
            End With
            
            ThisWorkbook.ShowPivotTableFieldList = False ' fermeture de la fenetre de selection de champs
            
            Set ShtDst = Nothing
        End If
        Set ShtSrc = Nothing
    Application.ScreenUpdating = True
End Sub

++
Minick

EDIT: pour la mise en page je viens de voir que tu avais regle le probleme.