TCD via Macro, erreur d'exécution '1004'

Version imprimable

25/07/2014, 10h44
Jimmy G.

1 pièce(s) jointe(s)

TCD via Macro, erreur d'exécution '1004'

Bonjour à toutes et à tous,

Je vous contacte car j'ai besoin d'aide, sur un fichier excel appelé "Calcul" j'ai un bouton qui lance une macro, cette macro viens extraire certaines données d'un autre classeur excel appelé "Stock". Sur le classeur stock j'ai des milliers de ligne, une ligne correspond à une référence articles et dans une colonne j'ai une quantité. La meme référence peut se retrouver sur plusieurs lignes, le but de la macro est d'envoyé sur mon classeur "Calcul" la liste des références avec la somme des quantités pour chacunes d'elles. Je me suis servis plusieurs fois de ce fichier "Calcul" pour une catégorie d'articles.
J'ai copier mon fichier calcul pour l'utiliser avec un autre fichier stock qui est exactement de la même forme que le premier, lorsque je lance ma macro cela ne fonctionne pas.

J'ai une fenetre qui apparait

Citation:

Erreur d'exécution 1004.
Cette commande requiert au moins deux lignes de données sources. Vous ne pouvez pas l'utiliser sur une seule ligne de données. Essayez la méthode suivante:
Si vous utilisez un filtre avancé, selectionnez une plage de cellules qui contient au moins deux lignes de données. Puis cliquez à nouveau sur la commande Filtre élaboré.
Continuer
25/07/2014, 10h52
illight

Le message est, je pense, assez explicite : pour faire ton TCD et l'actualiser, il te faut des données. A mon avis, la source de ton Tableau Croisé à un souci lors de l'actualisation.

As-tu essayé de faire le process manuellement, pour voir ce qui colle pas ? Essaye de faire du pas-à-pas, et juste avant d'actualiser ton tableau regarde les différents éléments :
- données sources de ton TCD, regarde s'il y a des données
- regarde dans tes données sources si une colonne n'aurait pas disparu, colonne qui est un des champs de ton TCD

Après, sans fichier sous les yeux, on pourra pas t'aider plus..

Je viens de me rendre compte que j'ai posté deux fois le même message par erreur du coup j'ai remis les explications de mon autre message

Bonjour à toutes et à tous,
Je vous contacte car je suis novice en VBA et je n’arrive pas à solutionner mon problème. (De plus je ne suis pas l'auteur du code)

J’ai un fichier Excel « Calcul » qui me permet d’extraire d’un autre fichier « Stock » des références d’articles avec des quantités, la macro extrait les données brutes du fichier stock où les références peuvent être répété plusieurs fois et fait un TCD sur le fichier Excel « Calcul » pour listé les références et sommer les quantités.
J’ai voulu utiliser ce fichier Calcul pour une autre catégorie d’article, avec donc un autre fichier Excel « Stock2 » qui est exactement de la même forme que le premier (seules les infos dans les cellules et le nombre de lignes changent). Et là je rencontre une erreur.
Erreur d’exécution ‘1004’
Cette commande requiert au moins deux lignes de données sources. Vous ne pouvez pas l’utiliser sur une seule ligne de données. Essayez la méthode suivante :
Si vous utilisez un filtre avancé, sélectionnez une plage de cellules qui contient au moins deux lignes de données. Puis cliquez à nouveau sur la commande Filtre élaboré
Continuer Fin Débogage Aide
Voici le début du code de la macro ;
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 Sub STOCK() 'Enlève la protection de la feuille 'Sheets("STOCK").Unprotect 'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà Application.DisplayAlerts = False For Each X In Sheets If X.Name = "STOCK" Then X.Unprotect Next For Each X In Sheets If X.Name = "STOCK" Then X.Delete Next Application.DisplayAlerts = True Dim dernière_ligne As Integer ' Dernière ligne de la base stock Workbooks.Open Filename:= _ "U:\\STOCK MARO.xlsx" Windows("STOCK MARO.xlsx").Activate derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row ' Enregistrement du tableau Dim tab_stock() Dim ligne As Integer ReDim tab_stock(derniere_ligne - 2, 4) Windows("STOCK MARO.xlsx").Activate ligne = 0 For i = 2 To derniere_ligne Vemp = Left(Sheets("Données").Range("F" & i), 1) If Vemp = 1 Then tab_stock(ligne, 0) = Sheets("Données").Range("B" & i) tab_stock(ligne, 1) = Sheets("Données").Range("F" & i) tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i) tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i) ligne = ligne + 1 End If Next Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False 'Affichage tableau dans excel Sheets.Add(Sheets(Sheets.Count)).Name = "PREV" Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP" For ligne = 2 To UBound(tab_stock) Windows("Calcul.xlsm").Activate Sheets("PREV").Range("A1") = "SKU" Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0) 'Sheets("PREV").Range("B1") = "EMPLACEMENT" 'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1) Sheets("PREV").Range("B1") = "QUANTITE" Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2) 'Sheets("PREV").Range("D1") = "QUALITE" 'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3) Next ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ [PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _ TableDestination:="TEMP!R1C1", _ TableName:="MonStock" With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU") .Orientation = xlRowField .Position = 1 End With Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _ "MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _ "Sum of QUANTITE"
J'ai mis en rouge la partie où l'erreur est détéctée.

En éspérant avoir été clair et que quelqu'un pourra m'aider, je vous remercie d'avance.

Bonne journée à toutes et à tous

Jimmy G.

PS: je n'arrive pas à mettre les fichiers en pièces jointes (Fichier non valide - alors que c'est un .xlsm)

25/07/2014, 12h17
NVCfrm

bonjour,

Citation:

ThisWorkbook.PivotCaches.Add

n'existe pas.
La methode Add s'applique plutôt à l'objet PivotTables de WorkSheet.
Essaies.

Code:

ThisWorkbook.PivotCaches.Create

1 pièce(s) jointe(s)

Merci pour vos réponses mais j'ai essayé de modifier Add -> Create et ça ne fonctionne pas, le pas à pas de la macro ne m'aide pas non plus.

Je ne vois pas quel est le problème.
Si cela peut aider quelqu'un à trouver une solution voila les fichiers.

Pièce jointe 151981

J'ai mis en pièce jointe mon fichier "stock" et j'ai mis le code du deuxième fichier; le fichier "Calcul" ci dessous parce que je ne peux pas insérer de pièce jointe en .xlsm

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
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Sub STOCK()
 
'Enlève la protection de la feuille
 
'Sheets("STOCK").Unprotect
 
'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà
    Application.DisplayAlerts = False
        For Each X In Sheets
            If X.Name = "STOCK" Then X.Unprotect
        Next
        For Each X In Sheets
            If X.Name = "STOCK" Then X.Delete
        Next
    Application.DisplayAlerts = True
    Dim dernière_ligne As Integer
 
' Dernière ligne de la base stock
    Workbooks.Open Filename:= _
        "U:\STOCK MARO.xlsx"
    Windows("STOCK MARO.xlsx").Activate
    derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row
 
' Enregistrement du tableau
    Dim tab_stock()
    Dim ligne As Integer
    ReDim tab_stock(derniere_ligne - 2, 4)
 
    Windows("STOCK MARO.xlsx").Activate
    ligne = 0
 
        For i = 2 To derniere_ligne
        Vemp = Left(Sheets("Données").Range("F" & i), 1)
            If Vemp = 1 Then
                tab_stock(ligne, 0) = Sheets("Données").Range("B" & i)
                tab_stock(ligne, 1) = Sheets("Données").Range("F" & i)
                tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i)
                tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i)
                ligne = ligne + 1
            End If
        Next
    Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False
 
'Affichage tableau dans excel
    Sheets.Add(Sheets(Sheets.Count)).Name = "PREV"
    Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP"
 
        For ligne = 2 To UBound(tab_stock)
            Windows("Calcul.xlsm").Activate
            Sheets("PREV").Range("A1") = "SKU"
            Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0)
            'Sheets("PREV").Range("B1") = "EMPLACEMENT"
            'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1)
            Sheets("PREV").Range("B1") = "QUANTITE"
            Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2)
            'Sheets("PREV").Range("D1") = "QUALITE"
            'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3)
        Next
 
    ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    [PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
    TableDestination:="TEMP!R1C1", _
    TableName:="MonStock"
 
        With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU")
            .Orientation = xlRowField
            .Position = 1
        End With
    Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _
        "MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum
    Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _
        "Sum of QUANTITE"
 
' Mise à jour tabstock
    Erase tab_stock()
    Dim dligne_TCD As Integer
    dligne_TCD = Sheets("TEMP").Range("A1").End(xlDown).Row
    ReDim tab_stock(dligne_TCD - 2, 3)
 
        For i = 3 To dligne_TCD - 1
            Pos = 0
            Pos = InStr(1, Sheets("TEMP").Range("A" & i), " ", 0) 'trouve la position de " "
            tab_stock(i - 3, 0) = Left(Sheets("TEMP").Range("A" & i), Pos - 1) ' enregistre uniquement le SKU
            tab_stock(i - 3, 1) = Sheets("TEMP").Range("B" & i) ' enregistre la quantité
        Next
 
'Nettoyage classeur
    Application.DisplayAlerts = False
    Worksheets("PREV").Delete
    Worksheets("TEMP").Delete
    Application.DisplayAlerts = True
 
'Affichage EXCEL
    Sheets.Add(Sheets(Sheets.Count)).Name = "STOCK"
    Sheets("STOCK").Move After:=Sheets(2)
 
        For ligne = 2 To UBound(tab_stock)
            Sheets("STOCK").Range("A1") = "SKU"
            Sheets("STOCK").Range("A" & ligne) = tab_stock(ligne - 2, 0)
            Sheets("STOCK").Range("B1") = "QUANTITE"
            Sheets("STOCK").Range("B" & ligne) = tab_stock(ligne - 2, 1)
        Next
 
'Mettre en forme le tableau et figer la première ligne
    Rows("1:1").RowHeight = 60
    Range("A1:B1").Select
    Selection.Font.Bold = True
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    Range("B1").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
        End With
    ActiveWindow.FreezePanes = True
    Columns("A:A").ColumnWidth = 20
   ' Range("A1:B1").Select
   ' Selection.AutoFilter
 
 
'Création du bouton retour à la page d'acceuil
    ActiveSheet.Buttons.Add(200, 10, 250, 40).Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Characters.Text = "Revenir à la première page"
        With Selection.Characters(Start:=1, Length:=26).Font
            .Name = "Calibri"
            .FontStyle = "Gras"
            .Size = 17
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = True
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 3
            Selection.OnAction = "Accueil"
            ActiveWindow.Panes(3).Activate
            Range("A2").Select
        End With
 
'Protège lA feuille STOCK
    Sheets("STOCK").Protect
 
End Sub

Merci d'avance

Bonjour,

Comme le disait Illight, l'erreur est provoquée parce que tu n'as aucune donnée dans la zone définie comme source de ton TCD.

Cette partie du code, qui génère l'erreur, fait référence à deux en-têtes de colonne de ta feuille "PREV" ce qui n'est pas suffisant pour créer un TCD :

Code:

1
2
3
4
ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
[PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
TableDestination:="TEMP!R1C1", _
TableName:="MonStock"

Pour que ton code fonctionne il faut modifier la ligne suivante :

Code:

If Vemp = 1 Then

Comme ceci :

Code:

If Vemp = 1 or Vemp = 3 Then

Ici, tu test si le premier caractère de la cellule de la colonne F est égal à 1 ou 3 et non pas seulement à 1.
Dans le fichier que tu fournis, aucune référence ne commence par 1 notamment parce que ça doit être une différence entre tes catégories d'articles :

Citation:

J’ai voulu utiliser ce fichier Calcul pour une autre catégorie d’article

Voici ton code modifié :

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
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Sub STOCK()
 
'Enlève la protection de la feuille
 
'Sheets("STOCK").Unprotect
 
'Permet de faire une nouvelle acquisition du stock, supprime la feuille STOCK si elle existe déjà
Application.DisplayAlerts = False
For Each X In Sheets
If X.Name = "STOCK" Then X.Unprotect
Next
For Each X In Sheets
If X.Name = "STOCK" Then X.Delete
Next
Application.DisplayAlerts = True
Dim dernière_ligne As Integer
 
' Dernière ligne de la base stock
Workbooks.Open Filename:= _
"U:\STOCK MARO.xlsx"
Windows("STOCK MARO.xlsx").Activate
derniere_ligne = Sheets("Données").Range("A1").End(xlDown).Row
 
' Enregistrement du tableau
Dim tab_stock()
Dim ligne As Integer
ReDim tab_stock(derniere_ligne - 2, 4)
 
Windows("STOCK MARO.xlsx").Activate
ligne = 0
 
For i = 2 To derniere_ligne
vemp = Left(Sheets("Données").Range("F" & i), 1)
If vemp = 1 Or vemp = 3 Then
tab_stock(ligne, 0) = Sheets("Données").Range("B" & i)
tab_stock(ligne, 1) = Sheets("Données").Range("F" & i)
tab_stock(ligne, 2) = Sheets("Données").Range("CM" & i)
tab_stock(ligne, 3) = Sheets("Données").Range("CX" & i)
ligne = ligne + 1
End If
Next
Workbooks("STOCK MARO.xlsx").Close SaveChanges:=False
 
'Affichage tableau dans excel
Sheets.Add(Sheets(Sheets.Count)).Name = "PREV"
Sheets.Add(Sheets(Sheets.Count)).Name = "TEMP"
 
For ligne = 2 To UBound(tab_stock)
Windows("Calcul.xlsm").Activate
Sheets("PREV").Range("A1") = "SKU"
Sheets("PREV").Range("A" & ligne) = tab_stock(ligne - 2, 0)
'Sheets("PREV").Range("B1") = "EMPLACEMENT"
'Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 1)
Sheets("PREV").Range("B1") = "QUANTITE"
Sheets("PREV").Range("B" & ligne) = tab_stock(ligne - 2, 2)
'Sheets("PREV").Range("D1") = "QUALITE"
'Sheets("PREV").Range("D" & ligne) = tab_stock(ligne - 2, 3)
Next
 
ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
[PREV!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
TableDestination:="TEMP!R1C1", _
TableName:="MonStock"
 
With Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU")
.Orientation = xlRowField
.Position = 1
End With
Worksheets("TEMP").PivotTables("MonStock").AddDataField Worksheets("TEMP").PivotTables( _
"MonStock").PivotFields("QUANTITE"), "Sum of QUANTITE", xlSum
Worksheets("TEMP").PivotTables("MonStock").PivotFields("SKU").AutoSort xlDescending, _
"Sum of QUANTITE"
 
' Mise à jour tabstock
Erase tab_stock()
Dim dligne_TCD As Integer
dligne_TCD = Sheets("TEMP").Range("A1").End(xlDown).Row
ReDim tab_stock(dligne_TCD - 2, 3)
 
For i = 3 To dligne_TCD - 1
Pos = 0
Pos = InStr(1, Sheets("TEMP").Range("A" & i), " ", 0) 'trouve la position de " "
tab_stock(i - 3, 0) = Left(Sheets("TEMP").Range("A" & i), Pos - 1) ' enregistre uniquement le SKU
tab_stock(i - 3, 1) = Sheets("TEMP").Range("B" & i) ' enregistre la quantité
Next
 
'Nettoyage classeur
Application.DisplayAlerts = False
Worksheets("PREV").Delete
Worksheets("TEMP").Delete
Application.DisplayAlerts = True
 
'Affichage EXCEL
Sheets.Add(Sheets(Sheets.Count)).Name = "STOCK"
Sheets("STOCK").Move After:=Sheets(2)
 
For ligne = 2 To UBound(tab_stock)
Sheets("STOCK").Range("A1") = "SKU"
Sheets("STOCK").Range("A" & ligne) = tab_stock(ligne - 2, 0)
Sheets("STOCK").Range("B1") = "QUANTITE"
Sheets("STOCK").Range("B" & ligne) = tab_stock(ligne - 2, 1)
Next
 
'Mettre en forme le tableau et figer la première ligne
Rows("1:1").RowHeight = 60
Range("A1:B1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Columns("A:A").ColumnWidth = 20
' Range("A1:B1").Select
' Selection.AutoFilter
 
 
'Création du bouton retour à la page d'acceuil
ActiveSheet.Buttons.Add(200, 10, 250, 40).Select
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "Revenir à la première page"
With Selection.Characters(Start:=1, Length:=26).Font
.Name = "Calibri"
.FontStyle = "Gras"
.Size = 17
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = True
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
Selection.OnAction = "Accueil"
ActiveWindow.Panes(3).Activate
Range("A2").Select
End With
 
'Protège lA feuille STOCK
Sheets("STOCK").Protect
 
End Sub

Chtik

28/07/2014, 10h06
Jimmy G.

Bonjour à tous,

merci beaucoup pour vos réponses, cela fonctionne à présent.

J'en profite pour demander un autre conseil étant donné l'efficacité du forum, dans le code

Citation:

If Vemp = 1 or Vemp = 3 Then

Si je souhaite au contraire exclure des données qui commence par un Q ou un C

Comment dois-je écrire mon code ?

j'ai essayé ce code mais ca ne fonctionne

Citation:

If Vemp <> "Q" or Vemp <> "C" Then

C'était une question bonus, je vais bien entendu signaler que le post est résolu

Bonne journée à tous