Bonjour,

Le code suivant s'éxécute plusieurs fois d'affilée.
Seuls les entiers entre 1 et 100 sont autorisés en colonne J par restriction de validation de donnée.
Lorsque je saisis une valeur non autorisée dans la cellule, j'ai 2 solutions
- soit J'annule et alors l'évènement worksheet_change est quand même lancé => problème car je copie une ligne à tord
- soit je clic ré-essayer et mets une valeur entre 1 et 100 et alors la sub est lancée plusieurs fois, j'ai plusieurs fois mes msgbox et la ligne est copiée plusieurs fois


Comprenez vous pourquoi ?
Comment puis je faire pour que la sub ne soit effectuée qu'une fois et lorsque je rentre une valeur autorisée

Merci d'avance



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
Private Sub worksheet_change(ByVal target As Range)
 
Dim keycells As Range
Dim i As Integer
Dim CopyRange As Range
Dim PasteRange As Range
 
Dim lastrowjournal As Integer
 
 
Application.EnableEvents = False
MsgBox ("la feuille a bougé")
 
If target.Count > 1 Then
' MsgBox (" target.count " & target.Count)
  Application.EnableEvents = True
  Exit Sub
End If
 
 
Set keycells = Range("J3:J10")
If Not Application.Intersect(keycells, Range(target.Address)) Is Nothing Then
 
    MsgBox ("la colonne J  a bougé")
 
    For i = 3 To 10
        If Not Application.Intersect(Range("J" & i), Range(target.Address)) Is Nothing Then
            MsgBox ("la cellule J" & i & " a bougé")
            Set CopyRange = ThisWorkbook.ActiveSheet.Range("A" & i).Resize(1, 100)
            With ThisWorkbook.Sheets("journal")
                lastrowjournal = ThisWorkbook.Sheets("journal").Cells(Rows.Count, "A").End(xlUp).Row
                Set PasteRange = ThisWorkbook.Sheets("journal").Range(.Cells(lastrowjournal + 1, 1), .Cells(lastrowjournal + 1, 100))
            End With
            PasteRange.Value2 = CopyRange.Value2
        End If
    Next
End If
 
Application.EnableEvents = True
 
 
End Sub
Nom : capture.png
Affichages : 888
Taille : 46,2 Ko