Discussion :

[chefsun]

Bonjour,
je ne suis pas devellopeur mais j'ai créés une procédure dans excel la voici

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
Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
 
Dim num As Integer 
If Not Intersect(Target, Range("r1:r" & Range("C65536").End(xlUp).Row)) Is Nothing Then 
 
If Cells(Target.Row, 13) < 3 Then 
Cells(Target.Row, 13) = Cells(Target.Row, 13) + 1 
Cells(Target.Row, Target.Column).Font.ColorIndex = 5 
Cells(Target.Row, Target.Column + 1).Font.ColorIndex = 5 
End If 
End If 
If Not Intersect(Target, Range("w1:w" & Range("C65536").End(xlUp).Row)) Is Nothing Then 
If Cells(Target.Row, 13) < 3 Then 
Cells(Target.Row, 13) = Cells(Target.Row, 13) + 1 
Cells(Target.Row, Target.Column).Font.ColorIndex = 5 
End If 
End If 
If Not Intersect(Target, Range("y1:y" & Range("C65536").End(xlUp).Row)) Is Nothing Then 
If Cells(Target.Row, 13) < 3 Then 
Cells(Target.Row, 13) = Cells(Target.Row, 13) + 1 
Cells(Target.Row, Target.Column).Font.ColorIndex = 5 
End If 
End If 
 
End Sub

tout fonctionne tres bien sur toutes les pages qui correspond au mois de l'année, quand je fait mes 2 clic sur soit une des cellules de la colonne r, w ou y ma police se met en bleu et mes cellules de la colonne M est bien incrementé de 1

le pb estque si je fais un copié collé d"une ligne de janvier a fevrier par ex ma cellule de la colonne A et B se met en bleu, ainsi que la rs wy et dans colonne M ma cellule se met directement à 3 alors que moi je ne veux pas de modif
je ne vois pas pourquoi il me fais ses modifs
avez vous une idéé ?

[mercatog]

Essaies comme ceci

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_Change(ByVal Target As Excel.Range)
Dim LastLig As Long
 
If Target.Count = 1 Then
    LastLig = Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
    If Not Intersect(Target, Union(Range("R1:R" & LastLig), Range("Y1:Y" & LastLig), Range("W1:W" & LastLig))) Is Nothing Then Trans Target
End If
End Sub
 
Private Sub Trans(ByVal Rng As Range)
 
On Error Resume Next
Application.EnableEvents = False
If Val(Cells(Rng.Row, 13)) < 3 Then
    Cells(Rng.Row, 13) = Val(Cells(Rng.Row, 13)) + 1
    Cells(Rng.Row, Rng.Column).Font.ColorIndex = 5
End If
On Error GoTo 0
Application.EnableEvents = True
End Sub

Regarde en particulier dans l'aide EnableEvents.

[chefsun]

ca ne marche pas a moin que j'ais fait une erreur je te passe le fichier

[mercatog]

ca ne marche pas

C'est le genre de réponses qui n'apporte aucun élément de réponse.

Explique clairement ce que tu souhaites faire et ce que tu rencontre comme problème (en se basant sur ke fichier que tu viens de joindre)

[chefsun]

si tu copie une ligne de janvier et que tu la colle dans la feuille fevrier
les cellules de cette ligne de la colonne A et B se mette en bleu ( pourquoi?)
ainsi que pour R , s et w et y et la cellule de la colonne m s'incremente automatiquement comme si la macro se mettait en marche
mais moi je veux juste un copié coller
car si la cellule se met en bleu cela veut dire que la facture à été validé et la ce n'est pas le cas

[mercatog]

Bon, j'ai supprimé la procédure du module de la feuille et j'ai mis une nouvelle dans le module ThisWorkbook (ceci n'a pas d'influence sur le code mais pour qu'un seul code sera pris en compte pour toutes les feuilles)

Je copie des lignes entre feuilles sans que le code soit appelé et sans que les cellules A et B s colorient.


Code à mettre dans le module ThisWorkbook en effaçant au préalable les codes de chaque feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LastLig As Long
 
If Target.Count = 1 Then
    LastLig = Sh.Cells(Sh.Rows.Count, "C").End(xlUp).Row
    If Not Intersect(Target, Union(Sh.Range("R1:R" & LastLig), Sh.Range("Y1:Y" & LastLig), Sh.Range("W1:W" & LastLig))) Is Nothing Then Trans Sh, Target
End If
End Sub
 
Private Sub Trans(ByVal Sh As Worksheet, ByVal Rng As Range)
 
On Error Resume Next
Application.EnableEvents = False
With Sh
    If Val(.Cells(Rng.Row, 13)) < 3 Then
        .Cells(Rng.Row, 13) = Val(.Cells(Rng.Row, 13)) + 1
        .Cells(Rng.Row, Rng.Column).Font.ColorIndex = 5
    End If
End With
On Error GoTo 0
Application.EnableEvents = True
End Sub