Bonjour
Je voulais savoir si je fais peux que ma vba

Code vb : 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
Private Sub Worksheet_Change(ByVal Target As Range)
 
 
Dim OS As Variant 'déclare le tableau des variables OS
 
Dim F As Worksheet 'déclare la variable F
 
Dim I As Byte 'déclare la variable I (Incrément)
 
Dim WS As Worksheet
 
Dim wss As Worksheet
 
 
Application.ScreenUpdating = False
 
       For Each WS In Sheets(Array("HJanvier", "HFevrier", "HMars", "HAvril", "HMai", "HJuin", "HJuillet", "HAout", "HSeptembre", "HOctobre", _
 
         "HNovembre", "HDecembre", "BJanvier", "BFevrier", "BMars", "BAvril", "BMai", "BJuin", "BJuillet", "BAout", "BSeptembre", "BOctobre", _
 
         "BNovembre", "BDecembre", "Bilan"))
 
            If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
 
              WS.Unprotect "azerty"
 
              WS.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
 
              WS.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
 
              , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
 
            End If
 
       Next WS
 
 
       For Each wss In Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", _
 
         "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre"))
 
            If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
 
              wss.Unprotect "azerty"
 
              wss.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
 
              wss.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
 
              , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
 
            End If
 
       Next wss
 
Application.ScreenUpdating = True
 
 
End Sub
qui devrais relancer ou du moins faire la meme chose as savoir que quand elle a fini elle doit masquer les ligne en x je sais pas si je suis clair le call ne veut pas fonctionner il met une erreur

Code vb : 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
131
132
133
134
135
136
137
138
139
140
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
 
Dim OS As Variant 'déclare le tableau des variables OS
 
 
Dim F As Worksheet 'déclare la variable F
 
 
Dim I As Byte 'déclare la variable I (Incrément)
 
 
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
 
 
'si la cellule double-cliquée se trouve dans une ligne inférieure à 6 ou supérieure à 65, sort de la procédure
 
 
If Target.Row < 6 Or Target.Row > 65 Then Exit Sub
 
 
'si la cellule double-cliquée se trouve dans une colonne inférieure à 9 ou supérieure à 16, sort de la procédure
 
 
If Target.Column < 9 Or Target.Column > 19 Then Exit Sub
 
 
Cancel = True 'annule le mode [Édition] lié au double-clic
 
 
Select Case Target.Column 'agit en fonction de la colonne double-cliquée
 
 
    Case 9 'cas 9 (=> colonne I)
 
 
        Set OS = Sheets(Array("HJanvier", "Janvier", "BJanvier")) 'définit le tableau des onglets OS
 
 
    Case 10 'cas 10 (=> colonne J)
 
 
        Set OS = Sheets(Array("HFevrier", "Fevrier", "BFevrier")) 'définit le tableau des onglets OS
 
 
    Case 11 'cas 11 (=> colonne K)
 
 
        Set OS = Sheets(Array("HMars", "Mars", "BMars")) 'définit le tableau des onglets OS
 
 
    Case 12 'cas 12 (=> colonne L)
 
 
        Set OS = Sheets(Array("HAvril", "Avril", "BAvril")) 'définit le tableau des onglets OS
 
 
    Case 13 'cas 13 (=> colonne M)
 
 
        Set OS = Sheets(Array("HMai", "Mai", "BMai")) 'définit le tableau des onglets OS
 
 
    Case 14 'cas 14 (=> colonne N)
 
 
        Set OS = Sheets(Array("HJuin", "Juin", "BJuin")) 'définit le tableau des onglets OS
 
 
    Case 15 'cas 15 (=> colonne O)
 
 
        Set OS = Sheets(Array("HJuillet", "Juillet", "BJuillet")) 'définit le tableau des onglets OS
 
 
    Case 16 'cas 16 (=> colonne P)
 
 
        Set OS = Sheets(Array("HAout", "Aout", "BAout")) 'définit le tableau des onglets OS
 
 
    Case 16 'cas 16 (=> colonne P)
 
 
        Set OS = Sheets(Array("HSetempbre", "Septembre", "BSeptembre")) 'définit le tableau des onglets OS
 
 
    Case 17 'cas 17 (=> colonne Q)
 
 
        Set OS = Sheets(Array("HOctobre", "Octobre", "BOctobre")) 'définit le tableau des onglets OS
 
 
    Case 18 'cas 18 (=> colonne R)
 
 
        Set OS = Sheets(Array("HNovembre", "Novembre", "BNovembre")) 'définit le tableau des onglets OS
 
 
    Case 19 'cas 19 (=> colonne S)
 
 
        Set OS = Sheets(Array("HDecembre", "Decembre", "BDecembre")) 'définit le tableau des onglets OS
 
 
End Select 'fin de l'action en fonction de la colonne double-cliquée
 
 
Target.Value = IIf(Target.Value = "X", "", "X") 'de'finit la valeur de la cellule double-cliquée (X si vide, vide si X)
 
 
For Each F In OS 'boucle sur tous les onglets du tableau des onglets OS
 
 
    If F.Range("A6") = "Jours" And F.Range("A8") = Range("X26") Then 'condition 1
 
 
        For I = 9 To 65 'boucle sur les ligne 9 à 65
 
 
            'si la condition est respectée masque la feuille si la cellule vaut X, sinon la ligne reste affichée
 
 
            If F.Range("A" & I) = Cells(Target.Row, 8).Value Then F.Rows(I).Hidden = Target.Value = "X"
 
 
        Next I 'prochaine ligne de la boucle
 
 
    End If 'fin de la condition
 
 
Next F 'prochain onglet de la boucle
 
 
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
 
 
End Sub

merci