Tableau CD vba

Bonjour tout le monde !

Pour l'automatisation de la création de 4 TCD, je suis parvenu à écrire ce code qui ne marche pas bien sur :mrgreen: et que VBA me sorte l'erreur "RunTime ERROR 5, invalid procedure call or argument" quand je l'execute ! J'ai loupé certainement un truc (ou des trucs) mais je ss pas en mesure de les détecter.

Le code ce-dessous effectuera le suivant : il va parcourir 4 feuilles excel, selectionne un champs, puis crée le tableau croisé dynamique correspondants dans une nouvelle autre feuille, c'est tout !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub Pivot_Tables_Maker()
 
'Crée les quatres pivot tables WIP TAJ
'Crée les quatres pivot tables WIP DLO
'Crée les quatres pivot tables CA TAJ
'Crée les quatres pivot tables CA DLO
 
Dim ws As Worksheet
Dim i As Integer
Dim j As Integer
 
i = 1
 
    For Each ws In Worksheets
        Select Case UCase(ws.Name)
           Case "CADRAGE_WIP_TAJ", "CADRAGE_WIP_DLO", "CADRAGE_CA_TAJ", "CADRAGE_CA_DLO"
           With ws
 
                Sheets(ws.Name).Select
                Range("A2").Select
                Range(Selection, Selection.End(xlToRight)).Select
                Range(Selection, Selection.End(xlToRight)).Select
                Range(Selection, Selection.End(xlToRight)).Select
                Range(Selection, Selection.End(xlToRight)).Select
                Range(Selection, Selection.End(xlToRight)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Range(Selection, Selection.End(xlDown)).Select
 
                Sheets.Add
 
                j = ActiveSheet.Index
 
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                    "ws.Name!R2C1:R1048576C10", Version:=xlPivotTableVersion14). _
                    CreatePivotTable TableDestination:="Sheet" & j & "!R3C1", TableName:=("PivotTable" & i) _
                    , DefaultVersion:=xlPivotTableVersion14
 
                Sheets("Sheet" & j).Select
                Cells(3, 1).Select
                With ActiveSheet.PivotTables("PivotTable" & i).PivotFields("TypologieFI")
                    .Orientation = xlRowField
                    .Position = 1
                End With
                ActiveSheet.PivotTables("PivotTable" & i).AddDataField ActiveSheet.PivotTables( _
                    "PivotTable" & i).PivotFields("TypologieFI"), "Count of TypologieFI", xlCount
                ActiveSheet.PivotTables("PivotTable" & i).AddDataField ActiveSheet.PivotTables( _
                    "PivotTable" & i).PivotFields("En-cours Indicateurs"), _
                    "Count of En-cours Indicateurs", xlCount
                ActiveSheet.PivotTables("PivotTable" & i).AddDataField ActiveSheet.PivotTables( _
                    "PivotTable" & i).PivotFields("En-cours Finance"), "Count of En-cours Finance", _
                    xlCount
                ActiveSheet.PivotTables("PivotTable" & i).AddDataField ActiveSheet.PivotTables( _
                    "PivotTable" & i).PivotFields("EcartFI"), "Count of EcartFI", xlCount
                With ActiveSheet.PivotTables("PivotTable" & i).PivotFields( _
                    "Count of En-cours Indicateurs")
                    .Caption = "Sum of En-cours Indicateurs"
                    .Function = xlSum
                End With
                With ActiveSheet.PivotTables("PivotTable" & i).PivotFields( _
                    "Count of En-cours Finance")
                    .Caption = "Sum of En-cours Finance"
                    .Function = xlSum
                End With
 
            i = i + 1
 
        End With
        End Select
        Next ws
 
End Sub

Merci pour vos suggestions et votre attention.

EDIT : A déplacer SVP dans le forum Macros et VBA ! Merci

sur qu'elle ligne l'erreur ?

Merci Modo,

Depuis la 37ème ligne ! please save me :ave:

Quand je remplace

Code:

TableDestination:="Sheet" & j & "!R3C1"

par

Code:

TableDestination:=("Sheet" & j & "!R3C1")

j'obtiens l'erreur suivante : Run Time Error '1004': Application-defined or object-defined error

merci

1 pièce(s) jointe(s)

Bonjour,
j'ai fait une class pour un autre client du forum.
regarde l'exemple:
c'est un fichier zip il faut décompresser le répertoire en entier!

Merci rdurupt pour la réponse :)

Le code apparemment est très bien fait, je vais bien l'explorer cette aprèm et te tiendrai au courant du résultat ici !

Merci bcp