Bonjour à tous,
Après de longues heures de recherches infructueuses dans ce forum et sur Internet, je m'en remets à vous...
J'ai une macro qui plante avec le message d'erreur suivant :
"Run-time error 1004 : unable to set the default property of the pivotitem class".
Cette macro sert à copier x copies d'une sheet vide au départ (sorte de template) et à remplir chaque sheet générée avec les valeurs obtenues dans le pivot table de la sheet "TCD_WP".
Chaque sheet à remplir correspond à une combinaison d'un field "unit" et d'un field "niveau".
J'espère que je suis assez clair... Sinon, n'hésitez pas à demander plus d'infos... Déjà bien merci...
Un apprenti-programmeur VBA désespéré et épuisé...
Voici le code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Sub génère_sheets_WP()
Dim Response As String
Dim dispo3(30), dispo4(30) As Double
Dim nocol(2), niv(2), nbunit(2) As Integer
 
For i = 1 To 23
    dispo3(i) = Sheets("data").Cells(i, 7)
Next i
For i = 1 To 24
    dispo4(i) = Sheets("data").Cells(i, 9)
Next i
Response = MsgBox("Faut-il effacer les sheets existantes ?", vbYesNo + vbQuestion + vbDefaultButton1, "Question")
If Response = vbYes Then
   nbsh = 0
   For Each ws In Worksheets
       nbsh = nbsh + 1
   Next ws
   Application.DisplayAlerts = False
   For i = 7 To nbsh
       Sheets(7).Activate
 
'       MsgBox "i = " & i & "  " & Sheets(i).Name
       Sheets(7).Delete
   Next i
   Application.DisplayAlerts = True
End If
'---------------------------------------- création des sheets
nbsh = 0
For Each ws In Worksheets
    nbsh = nbsh + 1
Next ws
 
For i = 24 To 1 Step -1
    newnom = Sheets("data").Cells(i, 4)
    Sheets("sheet_vide").Select
    Sheets("sheet_vide").Copy After:=Sheets(nbsh)
    Sheets("sheet_vide (2)").Select
    Sheets("sheet_vide (2)").Name = newnom
Next i
For i = 23 To 1 Step -1
    newnom = Sheets("data").Cells(i, 3)
    Sheets("sheet_vide").Select
    Sheets("sheet_vide").Copy After:=Sheets(nbsh)
    Sheets("sheet_vide (2)").Select
    Sheets("sheet_vide (2)").Name = newnom
Next i
'----------------------------------------------- Copier/coller TCD -> Sheets
nocol(1) = 1
nocol(2) = 2
nbunit(1) = 23
nbunit(2) = 24
niv(1) = 3
niv(2) = 4
 
Sheets("TCD_WP").Select
MsgBox ActiveSheet.PivotTables(1).Name
 
 
For j = 1 To 2
  For i = 1 To nbunit(j)
    nom_unit = Sheets("data").Cells(i, nocol(j))
    Sheets("TCD_WP").Select
    ActiveSheet.PivotTables(1).PivotFields("Unit").CurrentPage = nom_unit
    ActiveSheet.PivotTables(1).PivotFields("Niveau").CurrentPage = niv(j)
    nodl = Range("A65536").End(xlUp).Row
'    MsgBox nodl
    nodl = nodl - 1
    Rows("6:" & nodl).Select
    Selection.Copy
    newnom = Sheets("data").Cells(i, nocol(j) + 2)
    Sheets(newnom).Select
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown
 
    If j = 1 Then Cells(2, 1) = "Unit " & nom_unit & " Niv. 3"
    If j = 2 Then Cells(2, 1) = "Unit " & nom_unit & " Niv. 4+5"
    Cells(2, 4) = nom_unit
 
    Range("E5:N" & nodl - 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    If nodl > 6 Then
       With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
       End With
    End If
    Rows(4).Delete
    Rows(nodl - 1).Delete
    Cells(1, 1).Select
    Range("A" & nodl - 2 & ":C" & nodl - 2).Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    For k = 4 To 15
        If j = 1 Then Cells(nodl, k) = dispo3(i)
        If j = 2 Then Cells(nodl, k) = dispo4(i)
    Next k
    Cells(1, 1).Select
  Next i
Next j
End Sub