Bonjour,

Je me tourne vers vous car j'ai cette fameuse erreur d'exécution '91' qui m'embette. J'ai beau chercher, je ne trouve pas la solution à mon problème.

Je vous ai mis la ligne à problème en rouge dans le code ci-dessous.



Petite explication sur la macro : Je vous ai fait parvenir que la partie qui était nécessaire (les autres sont sensiblement identiques : juste les critères et les variables qui changent).

Son but :
Choisir dans un menu déroulant les critères qui nous intéresse, puis lorsque l'on clique sur le bouton associé, sur une première page prédéfinie cela me filtre ma base de données, puis sur une autre feuille me le retranscrit en TCD.

J'ai essayé de rafistoler une première erreur (Lignes en gras), où j'avais l'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. Essayer la méthode suivante : si vous utilisez un filtre élaboré, sélectionnez la plage de cellules qui contient au moins deux lignes de données. Puis cliquez à nouveau sur la commande Filtre élaboré.

D'où le fait qu'il y est "On Error Resume Next" et "On Error GoTo 0".





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
   '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
   On Error Resume Next
    Set pt2 = PTCache2.CreatePivotTable _
             (tabledestination:=ws6.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    On Error GoTo 0
     
    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



Merci à ceux qui prendront le temps de lire et de répondre à mon post.