Bonjour,
Gros souci avec mon code:

Dans un premier temps, je rempli les cellules ligne par ligne avec différentes commandes événementielles et, notamment, un passage de mes cellules de la colonne A en majuscules puis des remplissages par box, à la sélection et, avec un double clic, un tri automatique.

Le souci est que les deux se marchent sur les tuyaux et le tri ne peut se faire puisque les cellules sur lesquelles portent les sélections pour les macro sus mentionnées sont sélectionnées pour le tri.

Enfin c'est comme ça que je le comprends car je suis arrivé à court circuiter les remplissages en mettant des Exit Sub après mes Box.


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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rep As Integer
If Range("A" & ActiveCell.Row) <> "" And Range("G" & ActiveCell.Row) <> "" Then 'And InStr(1, Cells(Target.Row, 8), "") > 0 Then
 'rien faire
 'c'est la bonne cellule
'et tu peux rajouter un test sur le contenu
 
 
 
Rep = MsgBox("Voulez-vous trier ?", vbYesNo + vbQuestion, "TRI")
    If Rep = vbYes Then
Call TRI
 
Target.Offset(1, 1).Select
Selection.End(xlToLeft).Select
ActiveWorkbook.Save
Exit Sub
Else
Exit Sub
End If
End If
 
 
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Intersect(Target, [B2:B4000]) Is Nothing Then
 
ActiveWorkbook.Save
 'rien faire
 'c'est la bonne cellule
'et tu peux rajouter un test sur le contenu
Else
 
 
If Target.Offset(0, -1).Value <> "" And Target.Offset(0, 5).Value = "" Then
Target.Offset(0, -1) = UCase(Target.Offset(0, -1))
 
 
ActiveWorkbook.Save
 
 
End If
End If
 
Dim CAS As String
If Not Intersect(Target, Range("F2:F4000")) Is Nothing Then
CAS = InputBox("1 = Bourse au mérite" & vbCr & "2 = Bourse d'excellence" & vbCr & "3 = Bourse du second degré" & vbCr & "4 = Bourse enseignement supérieur" & vbCr & "5 = NON" & vbCr & "6 = OUI" & vbCr & "7 = AUTRE" & vbCr & "8 = TRI", "CAS PARTICULIER")
'Produit
    If CAS = 1 Then
    ActiveCell.Value = "Bourse au mérite "
    Target.Offset(0, 1).Select
 
    End If
 
     If CAS = 2 Then
    ActiveCell.Value = "Bourse d'excellence "
    Target.Offset(0, 1).Select
    End If
     If CAS = 3 Then
    ActiveCell.Value = "Bourse du second degré "
    Target.Offset(0, 1).Select
    End If
    If CAS = 4 Then
    ActiveCell.Value = "Bourse enseignement supérieur "
    Target.Offset(0, 1).Select
    End If
    If CAS = 5 Then
    ActiveCell.Value = "NON "
    Target.Offset(0, 1).Select
    End If
    If CAS = 6 Then
    ActiveCell.Value = "OUI "
    Target.Offset(0, 1).Select
    End If
      If CAS = 7 Then
      ActiveCell.Value = InputBox("Ton texte")
    'ActiveCell.Value = ""
    Target.Offset(0, 1).Select
    End If
    If CAS = 8 Then
 
    'Target.Offset(0, 1).Select
    Exit Sub
    End If
    End If
 
    Dim FILIERE As String
If Not Intersect(Target, Range("G2:G4000")) Is Nothing Then
FILIERE = InputBox("1 = ECS Option scientifique" & vbCr & "2 = ECT Option Technologique" & vbCr & "3 = Lettres" & vbCr & "4 = MPSI" & vbCr & "5 = PCSI" & vbCr & "6 = TRI", "FILIERE DEMANDEE")
'Produit
   If FILIERE = 1 Then
    ActiveCell.Value = "ECS Option scientifique "
    Target.Offset(1, 1).Select
    Selection.End(xlToLeft).Select
    ActiveWorkbook.Save
    End If
 
     If FILIERE = 2 Then
    ActiveCell.Value = "ECT Option Technologique "
   Target.Offset(1, 1).Select
   Selection.End(xlToLeft).Select
   ActiveWorkbook.Save
    End If
     If FILIERE = 3 Then
    ActiveCell.Value = "Lettres "
    Target.Offset(1, 1).Select
    Selection.End(xlToLeft).Select
    ActiveWorkbook.Save
    End If
    If FILIERE = 4 Then
    ActiveCell.Value = "MPSI "
    Target.Offset(1, 1).Select
    Selection.End(xlToLeft).Select
    ActiveWorkbook.Save
    End If
    If FILIERE = 5 Then
    ActiveCell.Value = "PCSI "
    Target.Offset(1, 1).Select
    Selection.End(xlToLeft).Select
    End If
 
  If FILIERE = 6 Then
  Target.Offset(1, 1).Select
    Selection.End(xlToLeft).Select
    ActiveWorkbook.Save
    'Target.Offset(0, 1).Select
    Exit Sub
    End If
    End If
 
     Dim SEXE As String
If Not Intersect(Target, Range("D2:D4000")) Is Nothing Then
SEXE = InputBox("1 = F" & vbCr & "2 = M", "SEXE")
'Produit
    If SEXE = 1 Then
    ActiveCell.Value = "F "
    Target.Offset(0, 1).Select
    End If
 
     If SEXE = 2 Then
    ActiveCell.Value = "M "
    Target.Offset(0, 1).Select
     End If
 
    End If
 
    End Sub

Si quelqu'un a une idée pour court circuiter
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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Intersect(Target, [B2:B4000]) Is Nothing Then
 
ActiveWorkbook.Save
 'rien faire
 'c'est la bonne cellule
'et tu peux rajouter un test sur le contenu
Else
 
 
If Target.Offset(0, -1).Value <> "" And Target.Offset(0, 5).Value = "" Then
Target.Offset(0, -1) = UCase(Target.Offset(0, -1))
 
 
ActiveWorkbook.Save
 
 
End If
End If
???

J'ai essayé en donnant G<>"" comme condition dans le code pour le tri et G="" comme condition dans le code pour passer A en majuscules mais rien n'y fait



Merci