Macro pour plusieurs feuilles

Bonjour,

Je précise dans un premier temps que je n'ai pas de notions en VBA, je n'ai pas encore eu l'occasion d'apprendre ce langage. Et c'est pourquoi je viens à vous.

J'ai à disposition 12 feuilles (1601, 1602, 1603, etc ...) dont la structure est identique et je cherche à réaliser le même tableau croisé dynamique pour chacune (soit 12 tableaux). Pour cela, je suis passé par l'enregistreur de macro mais ça n'est pas concluant puisque cela prend en compte les paramètres de la feuille à partir de laquelle j'ai enregistré la macro.

L'idée étant dans cette macro de sélectionner mon tableau, d'insérer un TCD à la droite de celui - ci, puis de glisser les 2 variables qui m'intéressent (situation puis nb_week) dans Row Label.

Je cherche donc ici à modifier le "1601" enregistré en dur dans la macro par la feuille sur laquelle je me trouve. Ainsi, si le lance mon code sur la feuille "1607", alors ce paramètre sera pris en conséquence plutôt que "1601".

Cela ne me semble pas si compliqué ... mais sans les bases, je suis surtout en train de faire du bricolage plutôt qu'autre chose.

Bonjour,

je vous fait une proposition a votre mais je ne vous assure pas que cela fonctionne (je n'est pas le temps de le teste pour le moment et puis je suis allergie au TCD) :

remplacer les :

 "1601!R4C1:R1441C8" 

par

activesheet.range("la plage que vous souhaiter")

par pour tout les autre 1601 que vous souhaiter changer

Bonjour,

Une proposition à étudier.

Ton profil indique Excel 2003 et ta procédure réalisée avec Excel 2010.

Il est important que tu précises cette version, car il y a de nombreuses différences entre ces 2 versions.

Cdlt.

Option Explicit

Public Sub CreatePivoTable()
Dim wsData As Worksheet
Dim lastCol As Long, lastRow As Long
Dim rngData As Range
Dim PTCache As PivotCache
Dim pt As PivotTable

    Application.ScreenUpdating = False

    If ActiveSheet.PivotTables.Count > 0 Then
        MsgBox "Un TCD existe déja dans la feuille active.", vbExclamation
        Exit Sub
    End If

    Set wsData = ActiveSheet
    With wsData
        lastCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rngData = .Cells(4, 1).Resize(lastRow - 3, lastCol)
    End With

    Set PTCache = ActiveWorkbook.PivotCaches.Create _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngData)

    Set pt = PTCache.CreatePivotTable _
             (tabledestination:=wsData.Cells(4, lastCol + 2), _
              TableName:="PT_" & wsData.Name)

    With pt
        .ManualUpdate = True
        .AddFields RowFields:=Array("situation", "nb week")
        '
        '
        '
        .RowAxisLayout xlTabularRow
        .TableStyle2 = ""
        .ColumnGrand = False
        .RowGrand = False
        .ManualUpdate = False
    End With

    Set rngData = Nothing
    Set pt = Nothing: Set PTCache = Nothing
    Set wsData = Nothing

End Sub