Conditions qui s'exécute mal
Bonjour,
Je me suis lancée dans une boucles if, then, else.
Mais là, impossible de la faire marcher correctement !
J'ai dans ma macro, 3 "sous-macro", le but :
- si la première condition est fausse voir la deuxième
- si la deuxième est fausse voir la troisième
- si les deux premières sont fausses la troisième sera forcément vraie.
Mon problème est que la macro, me ressort toujours un TCD (but de la macro) sur la même condition même si celle-ci est fausse !
Comment cela se fait-il ? Et comment puis-je y remédier ?
Merci à ceux qui auront prit le temps de lire, et à ceux qui me répondront.
Option Explicit
Sub TEST_TRI()
'
' TEST_TRI Macro
' Macro enregistrée le 10/05/2016 par lycée
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Définition des critères pour CITEC
Sheets("Génération").Activate
If [B1] = 1 Or 2 And [C1] = 3 And [D1] = 1 Or 2 And [E1] = 1 Or 2 And [K1] = 1 Or 2 And [L1] = 1 Or 2 Then
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T4:AE5"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim rngPT As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Liste")
Set rngPT = ws.Cells(1).CurrentRegion 'Données sources du TCD
Set ws2 = wb.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws2.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache = wb.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt = PTCache.CreatePivotTable _
(tabledestination:=ws2.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
ColumnFields:="SEXE"
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb.ShowPivotTableFieldList = False
With ws2
.Activate
.[A1].Select
End With
Set rngPT = Nothing
Set pt = Nothing
Set PTCache = Nothing
Set ws2 = Nothing: Set ws = Nothing
Set wb = Nothing
Sheets("Tableau").Activate
'Définition des critères pour SC-IG
Sheets("Génération").Activate
ElseIf [B1] = 1 Or 2 And [C1] = 9 And [D1] = 1 Or 2 And [E1] = 1 Or 2 And [K1] = 1 Or 2 And [L1] = 1 Or 2 Then
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T7:AE8"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb1 As Workbook
Dim ws3 As Worksheet, ws4 As Worksheet
Dim PTCache1 As PivotCache
Dim pt1 As PivotTable
Dim rngPT1 As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb1 = ActiveWorkbook
Set ws3 = wb1.Worksheets("Liste")
Set rngPT1 = ws3.Cells(1).CurrentRegion 'Données sources du TCD
Set ws4 = wb1.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws4.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache1 = wb1.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT1)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt1 = PTCache1.CreatePivotTable _
(tabledestination:=ws4.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt1
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
ColumnFields:="SEXE"
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb1.ShowPivotTableFieldList = False
With ws4
.Activate
.[A1].Select
End With
Set rngPT1 = Nothing
Set pt1 = Nothing
Set PTCache1 = Nothing
Set ws4 = Nothing: Set ws3 = Nothing
Set wb1 = Nothing
Sheets("Tableau").Activate
'Définition des critères pour SES
Sheets("Génération").Activate
Else: [B1] = 4 And [C1] = 1 Or 2 And [D1] = 1 Or 2 And [E1] = 1 Or 2 And [K1] = 1 Or 2 And [L1] = 1 Or 2
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T17:AE18"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb2 As Workbook
Dim ws5 As Worksheet, ws6 As Worksheet
Dim PTCache2 As PivotCache
Dim pt2 As PivotTable
Dim rngPT2 As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb2 = ActiveWorkbook
Set ws5 = wb2.Worksheets("Liste")
Set rngPT2 = ws5.Cells(1).CurrentRegion 'Données sources du TCD
Set ws6 = wb2.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws6.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache2 = wb2.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT1)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt2 = PTCache2.CreatePivotTable _
(tabledestination:=ws6.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt2
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:="OPTION ECO", _
ColumnFields:=Array("OPTION 4", "SEXE")
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb2.ShowPivotTableFieldList = False
With ws6
.Activate
.[A1].Select
End With
Set rngPT2 = Nothing
Set pt2 = Nothing
Set PTCache2 = Nothing
Set ws6 = Nothing: Set ws5 = Nothing
Set wb2 = Nothing
Sheets("Tableau").Activate
End If
End Sub
noemiesamira a écrit :Et comment puis-je y remédier ?
Bonjour,
Déjà en commençant par joindre un fichier pour la bonne compréhension du problème. Car sans le fichier tester sera difficile.
J'ai rajouté le code pendant que tu rédigeais ta réponse. Si le fichier est vraiment nécessaire je peux le joindre en plus.
Bonjour,
If [B1] = 1 Or 2 And...
est faux
Remplacer par :
]If [B1] = 1 Or [B1] = 2 And...
et structures tes conditions avec des parenthèses si nécessaire :
If ([B1] = 1 Or [B1] = 2) And [C1] = 3 And ... Then
eric
Bonjour a toi !
Tout d'abord merci pour ta réponse.
J'ai donc modifié le code comme tu me l'as montré, mais quand j'exécute la macro un message d'erreur apparait !
erreur d'exécution '5' :
Argumennt ou appel de procédure incorrect
Option Explicit
Sub TEST_TRI()
'
' TEST_TRI Macro
' Macro enregistrée le 10/05/2016 par lycée
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Définition des critères pour CITEC
Sheets("Génération").Activate
If ([B1] = 1 And [B1] = 2) And [C1] = 3 And ([D1] = 1 And [D1] = 2) And ([E1] = 1 And [E1] = 2) And ([K1] = 1 And [K1] = 2) And ([L1] = 1 And [L1] = 2) Then
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T4:AE5"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim rngPT As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Liste")
Set rngPT = ws.Cells(1).CurrentRegion 'Données sources du TCD
Set ws2 = wb.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws2.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache = wb.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt = PTCache.CreatePivotTable _
(tabledestination:=ws2.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
ColumnFields:="SEXE"
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb.ShowPivotTableFieldList = False
With ws2
.Activate
.[A1].Select
End With
Set rngPT = Nothing
Set pt = Nothing
Set PTCache = Nothing
Set ws2 = Nothing: Set ws = Nothing
Set wb = Nothing
Sheets("Tableau").Activate
'Définition des critères pour SC-IG
Sheets("Génération").Activate
ElseIf ([B1] = 1 And [B1] = 2) And [C1] = 9 And ([D1] = 1 And [D1] = 2) And ([E1] = 1 And [E1] = 2) And ([K1] = 1 And [K1] = 2) And ([L1] = 1 And [L1] = 2) Then
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T7:AE8"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb1 As Workbook
Dim ws3 As Worksheet, ws4 As Worksheet
Dim PTCache1 As PivotCache
Dim pt1 As PivotTable
Dim rngPT1 As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb1 = ActiveWorkbook
Set ws3 = wb1.Worksheets("Liste")
Set rngPT1 = ws3.Cells(1).CurrentRegion 'Données sources du TCD
Set ws4 = wb1.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws4.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache1 = wb1.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT1)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt1 = PTCache1.CreatePivotTable _
(tabledestination:=ws4.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt1
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
ColumnFields:="SEXE"
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb1.ShowPivotTableFieldList = False
With ws4
.Activate
.[A1].Select
End With
Set rngPT1 = Nothing
Set pt1 = Nothing
Set PTCache1 = Nothing
Set ws4 = Nothing: Set ws3 = Nothing
Set wb1 = Nothing
Sheets("Tableau").Activate
'Définition des critères pour SES
Sheets("Génération").Activate
Else: [B1] = 4 And ([C1] = 1 And [C1] = 2) And ([D1] = 1 And [D1] = 2) And ([E1] = 1 And [E1] = 2) And ([K1] = 1 And [K1] = 2) And ([L1] = 1 And [L1] = 2)
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T17:AE18"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb2 As Workbook
Dim ws5 As Worksheet, ws6 As Worksheet
Dim PTCache2 As PivotCache
Dim pt2 As PivotTable
Dim rngPT2 As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb2 = ActiveWorkbook
Set ws5 = wb2.Worksheets("Liste")
Set rngPT2 = ws5.Cells(1).CurrentRegion 'Données sources du TCD
Set ws6 = wb2.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws6.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache2 = wb2.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT1)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt2 = PTCache2.CreatePivotTable _
(tabledestination:=ws6.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt2
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:="OPTION ECO", _
ColumnFields:=Array("OPTION 4", "SEXE")
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb2.ShowPivotTableFieldList = False
With ws6
.Activate
.[A1].Select
End With
Set rngPT2 = Nothing
Set pt2 = Nothing
Set PTCache2 = Nothing
Set ws6 = Nothing: Set ws5 = Nothing
Set wb2 = Nothing
Sheets("Tableau").Activate
End If
End Sub
Non seulement tu ne mets pas de fichier de test mais en plus tu ne dis même pas quelle ligne est en erreur. Aant cassé ma boule de cristal...
Et les ( ) ne se mettent pas au hasard ni pour faire joli avec une belle régularité. Il faut qu'elles correspondent exactement à ce que tu veux.
Par exemple :
([D1] = 1 And [D1] = 2) est strictement pareil avec ou sans. Au passage explique-moi quand [D1] peut être égal à 1 ET égal à 2 ???
Un peu de révision de tes cours de logique est nécessaire je pense.
Eriiic, en faisant défiler le code, vous remarquerez que la ligne qui bloque est surligné. Donc peut être que vos lunettes ont besoin d'une révision elles aussi.
J'ai suivi ce que vous me disiez, cela peut être égal à 1 OU 2, ce que j'avais écrit au début dans ma macro.
Je ne suis pas télépathe (ou pas encore du moins), je ne peux donc pas lire dans vos pensées, et si vous me dites que je peux faire de telle ou telle façon, je choisis celle que je préfère, donc pour éviter de faire des erreurs, ou pour ne pas critiquer par la suite, pensez à bien expliquer, car si quelqu'un se tourne vers vous, c'est qu'il ne sait pas forcément, et tout le monde n'est pas un pro de la programmation.
De plus, dans un post-réponse j'ai bien précisé que SI le fichier était nécessaire je pouvais le joindre. En avez-vous fait la demande ? Il ne me semble pas. Merci donc de surveiller vos dire.
Je vous prierai donc, de bien regarder, de lire, et de comprendre avant de répondre, et avant de juger ou donner des conseils, de bien lire également.
J'ai fait les modifications sur la macro, j'ai trouvé des zones d'erreurs, que j'ai traité, seulement maintenant, un nouveau message erreur s'affiche :
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 élaboré, sélectionnez une plage de cellules qui contient au moins deux lignes de donnée. Puis cliquez à nouveau sur la commande filtre élaboré.
'Définition des critères pour SES
Sheets("Génération").Activate
Else: [B1] = 4 And ([C1] = 1 Or [C1] = 2) And ([D1] = 1 Or [D1] = 2) And ([E1] = 1 Or [E1] = 2) And ([K1] = 1 Or [K1] = 2) And ([L1] = 1 Or [L1] = 2)
'Suppression TCD
Sheets("Tableau").Activate
Range("A1:Q300").Select
Range("Q300").Activate
Selection.Delete
'Suppresion Liste
Sheets("Liste").Activate
Range("A1:L400").Select
Range("L400").Activate
Selection.Delete
'Filtre élaboré pour trier la BD élève
Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Génération").Range("T17:AE18"), CopyToRange:=Sheets("Liste").Range( _
"A1:L1"), Unique:=False
Sheets("Liste").Select
'Tri de la feuille Liste, par Option 4 puis 5
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Déclaration des variables
Range("A1").Select
Dim wb2 As Workbook
Dim ws5 As Worksheet, ws6 As Worksheet
Dim PTCache2 As PivotCache
Dim pt2 As PivotTable
Dim rngPT2 As Range
'Optimisation (Gel Affichage)
Application.ScreenUpdating = False
'Initialisation des variables
Set wb2 = ActiveWorkbook
Set ws5 = wb2.Worksheets("Liste")
Set rngPT2 = ws5.Cells(1).CurrentRegion 'Données sources du TCD
Set ws6 = wb2.Worksheets("Tableau")
'Suppression TCD
On Error Resume Next
ws6.PivotTables(1).TableRange2.Clear
On Error GoTo 0
'Création du cache de TCD (à partir de rngPT)
Set PTCache2 = wb2.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngPT2)
'Création du TCD en feuille 'Tableau' nommé TCD_1
Set pt2 = PTCache2.CreatePivotTable _
(tabledestination:=ws6.Cells(6, 2), _
TableName:="TCD_1", _
defaultversion:=xlPivotTableVersion10)
With pt2
'Calcul TCD manuel (Optimisation)
.ManualUpdate = True
'Ajout des étiquettes de lignes et colonnes
.AddFields RowFields:="OPTION ECO", _
ColumnFields:=Array("OPTION 4", "SEXE")
'Ajout champ valeurs
With .PivotFields("NOM")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0"
.Caption = "NB NOMS"
End With
'Calcul automatique (affiche le TCD)
.ManualUpdate = False
End With
wb2.ShowPivotTableFieldList = False
With ws6
.Activate
.[A1].Select
End With
Set rngPT2 = Nothing
Set pt2 = Nothing
Set PTCache2 = Nothing
Set ws6 = Nothing: Set ws5 = Nothing
Set wb2 = Nothing
Sheets("Tableau").Activate
End If
End Sub
Je crois rêver...
C'est à moi de deviner qu'il faut faire défiler 100 lignes de programme pour voir qu'il y en a 1 que tu as surlignée ?
Et je passe sur le reste totalement incongru, il aurait trop à dire...
Je vais donc m'en tenir là et surtout ne te remet pas en cause.
eric
C'est de la logique, pas une devinette. Comme tu sais si bien le dire.
C'est effarant de voir des personnes comme toi, qui se croit au dessus des autres..
En tout cas, merci de ta petite aide, et de tes nombreuses reproches, cela me fait me sentir moins con et ingrate envers les personnes qui m'entourent.