Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Avec les évènementielles tu ne peux pas écrire 50 procédures worksheet_change pour la même feuille c'est pour cela que rien ne se passe, c'est à mettre dans
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range(Plage).Columns(3), Target) Is Nothing Then
If Len(Ch) = 0 Then Exit Sub
With UserForm1
.ListBox1.AddItem Ch
.ListBox2.AddItem Sheets(Right(Ch, 1) + 1).Name
.Show
End With
[A1]=[A1]+1
End If
End Sub
merci pour tes réponses
Zon peux tu me dire pourquoi rien ne se passe en A1
quand je supprime une des voitures de la colonne C
Le ompteur ne totalise rien
je te Zip le ficjhier
merci encor
Option Explicit
Const Plage As String = "A10😀15"
Dim Ch$
'Celle là est évènementielle
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range(Plage).Columns(3), Target) Is Nothing Then
If Len(Ch) = 0 Then Exit Sub
With UserForm1
.ListBox1.AddItem Ch
.ListBox2.AddItem Sheets(Right(Ch, 1) + 1).Name
.Show
End With
[A1] = [A1] + 1 'ici à rajouter<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ici on récupére la valeur de la cellule qui peut être modifiée
On Error Resume Next
Ch = Target.Text
End Sub
'
'Cette procédure n'est pas évènementielle
Private Sub Worksheet_Change1(ByVal Target As Range)
If Not Application.Intersect(Range(Plage).Columns(3), Target) Is Nothing Then
If Len(Ch) = 0 Then Exit Sub
With UserForm1
.ListBox1.AddItem Ch
.ListBox2.AddItem Sheets(Right(Ch, 1) + 1).Name
.Show
[A1] = [A1] + 1 'ici à rajouter
End With
End If
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.