erreur code VBA Selectionchange

Version imprimable

Bonjour,

J'essaie d'effacter une ligne lorsque je clique dans une certaine cellule. Tout fonctionne lorsque j'utilise ceci:

Code:

1
2
3
4
5
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("AA52")) Is Nothing Then
Range("J52:W52").ClearContents
End If
End Sub

mais pas lorsque j'écris cela:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("AA52")) Is Nothing Then
Range("J52:W52").ClearContents
End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("AA53")) Is Nothing Then
Range("J53:W53").ClearContents
End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("AA54")) Is Nothing Then
Range("J54:W54").ClearContents
End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("AA55")) Is Nothing Then
Range("J55:W55").ClearContents
End If
End Sub

Bref, j'essai d'effacer une ligne différente dépendamment de la cellule dans laquelle je clique.

Au plaisir

Il n'est pas possible d'avoir plusieurs exemplaire d'une même macro évènementielle pour un même objet.
De même qu'il n'est pas possible d'avoir plusieurs macro du même nom dans un même module.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address
Case Range("AA52").Address
    Range("J52:W52").ClearContents
Case Range("AA53").Address
    Range("J53:W53").ClearContents
Case Range("AA54").Address
    Range("J54:W54").ClearContents
Case Range("AA55").Address
    Range("J55:W55").ClearContents
End Select
End Sub

Ou, plus simplement :

Code:

1
2
3
4
5
6
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address(False, False)
Case "AA52", "AA53", "AA54", "AA55"
    Range("J1:W1").Offset(Target.Row - 1, 0).ClearContents
End Select
End Sub

Bonjour,

N'ayant pas plus d'info sur ce que tu veux faire exactement, tu peux essayer ceci (à adapter avec ton tableau):
Code:

1 2 3 4 5 6 7 8 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 1 Then Range(Cells(Target.Row, 2), Cells(Target.Row, 4)).ClearContents End If End Sub

02/08/2019, 13h35
Justine B

Merci beaucoup, ça fonctionne comme un charme!

Bonjour,

Mon code fonctionne très bien, sauf lorsque j'ouvre un fichier excel dont la cellule "W2" prend de l'info dans son calcul. Excel lance alors le code (car la cellule W2 se recalcule à l'ouverture du second fichier), ce qui cause des problèmes. J'aimerai que l'opération puisse uniquement s'effectuer lorsque je suis sur la feuille "PRESCRIPTION" du premier fichier. Que dois-je rajouter à mon code pour que se soit possible?

Code:

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
Private Sub Worksheet_Calculate()
    Dim target As Range
    Set target = Range("W2")
 
    If Not Intersect(target, Range("W2")) Is Nothing Then
 
Worksheets("PRESCRIPTION").Range("J52:J55").Value = Worksheets("PRES_START").Range("N6:N9").Value
Worksheets("PRESCRIPTION").Range("L52:L55").Value = Worksheets("PRES_START").Range("C6:C9").Value
Worksheets("PRESCRIPTION").Range("M52:M55").Value = Worksheets("PRES_START").Range("R6:R9").Value
Worksheets("PRESCRIPTION").Range("U52:U55").Value = Worksheets("PRES_START").Range("F6:F9").Value
Worksheets("PRESCRIPTION").Range("V52:V55").Value = Worksheets("PRES_START").Range("P6:P9").Value
Worksheets("PRESCRIPTION").Range("W52:W55").Value = Worksheets("PRES_START").Range("Q6:Q9").Value
Worksheets("PRESCRIPTION").Range("A66").Value = Worksheets("PRES_START").Range("FB2").Value
Worksheets("PRESCRIPTION").Range("C91").Value = Worksheets("PRES_START").Range("CN2").Value
Worksheets("PRESCRIPTION").Range("J91").Value = Worksheets("PRES_START").Range("AF2").Value
Worksheets("PRESCRIPTION").Range("A60:A63").Value = Worksheets("PRES_START").Range("E13:E16").Value
Worksheets("PRESCRIPTION").Range("C60:C63").Value = Worksheets("PRES_START").Range("F13:F16").Value
Worksheets("PRESCRIPTION").Range("E60:E63").Value = Worksheets("PRES_START").Range("H13:H16").Value
Worksheets("PRESCRIPTION").Range("G60:G63").Value = Worksheets("PRES_START").Range("O13:O16").Value
Worksheets("PRESCRIPTION").Range("I60:I63").Value = Worksheets("PRES_START").Range("K13:K16").Value
Worksheets("PRESCRIPTION").Range("A51:A54").Value = Worksheets("PRES_START").Range("C20:C23").Value
Worksheets("PRESCRIPTION").Range("B51:B54").Value = Worksheets("PRES_START").Range("D20:D23").Value
Worksheets("PRESCRIPTION").Range("C51:C54").Value = Worksheets("PRES_START").Range("F20:F23").Value
Worksheets("PRESCRIPTION").Range("D51:D54").Value = Worksheets("PRES_START").Range("G20:G23").Value
Worksheets("PRESCRIPTION").Range("E51:E54").Value = Worksheets("PRES_START").Range("H20:H23").Value
Worksheets("PRESCRIPTION").Range("F51:F54").Value = Worksheets("PRES_START").Range("I20:I23").Value
Worksheets("PRESCRIPTION").Range("G51:G54").Value = Worksheets("PRES_START").Range("J20:J23").Value
Worksheets("PRESCRIPTION").Range("H51:H54").Value = Worksheets("PRES_START").Range("K20:K23").Value
 
End If
 
End Sub

Merci d'avance pour vos conseils.

06/08/2019, 20h21
Pierre Fauconnier

Salut

Essaie avec

Code:

If Not Intersect(target, Range("W2")) Is Nothing And ActiveSheet = Worksheets("PRESCRIPTION) Then

Bonjour,

Je viens d'essayer ta suggestion et le code ne marche simplement pas. Il indique que l'erreur est dans la ligne en question. Je m'étais tromper dans le nom de la feuille active, c'était "recherche" et non pas "prescription".

Voici mon code

Code:

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
Private Sub Worksheet_Calculate()
    Dim target As Range
    Set target = Range("W2")
 
    If Not Intersect(target, Range("W2")) Is Nothing And ActiveSheet = Worksheets("recherche") Then
 
 
Worksheets("PRESCRIPTION").Range("J52:J55").Value = Worksheets("PRES_START").Range("N6:N9").Value
Worksheets("PRESCRIPTION").Range("L52:L55").Value = Worksheets("PRES_START").Range("C6:C9").Value
Worksheets("PRESCRIPTION").Range("M52:M55").Value = Worksheets("PRES_START").Range("R6:R9").Value
Worksheets("PRESCRIPTION").Range("U52:U55").Value = Worksheets("PRES_START").Range("F6:F9").Value
Worksheets("PRESCRIPTION").Range("V52:V55").Value = Worksheets("PRES_START").Range("P6:P9").Value
Worksheets("PRESCRIPTION").Range("W52:W55").Value = Worksheets("PRES_START").Range("Q6:Q9").Value
Worksheets("PRESCRIPTION").Range("A66").Value = Worksheets("PRES_START").Range("FB2").Value
Worksheets("PRESCRIPTION").Range("C91").Value = Worksheets("PRES_START").Range("CN2").Value
Worksheets("PRESCRIPTION").Range("J91").Value = Worksheets("PRES_START").Range("AF2").Value
Worksheets("PRESCRIPTION").Range("A60:A63").Value = Worksheets("PRES_START").Range("E13:E16").Value
Worksheets("PRESCRIPTION").Range("C60:C63").Value = Worksheets("PRES_START").Range("F13:F16").Value
Worksheets("PRESCRIPTION").Range("E60:E63").Value = Worksheets("PRES_START").Range("H13:H16").Value
Worksheets("PRESCRIPTION").Range("G60:G63").Value = Worksheets("PRES_START").Range("O13:O16").Value
Worksheets("PRESCRIPTION").Range("I60:I63").Value = Worksheets("PRES_START").Range("K13:K16").Value
Worksheets("PRESCRIPTION").Range("A51:A54").Value = Worksheets("PRES_START").Range("C20:C23").Value
Worksheets("PRESCRIPTION").Range("B51:B54").Value = Worksheets("PRES_START").Range("D20:D23").Value
Worksheets("PRESCRIPTION").Range("C51:C54").Value = Worksheets("PRES_START").Range("F20:F23").Value
Worksheets("PRESCRIPTION").Range("D51:D54").Value = Worksheets("PRES_START").Range("G20:G23").Value
Worksheets("PRESCRIPTION").Range("E51:E54").Value = Worksheets("PRES_START").Range("H20:H23").Value
Worksheets("PRESCRIPTION").Range("F51:F54").Value = Worksheets("PRES_START").Range("I20:I23").Value
Worksheets("PRESCRIPTION").Range("G51:G54").Value = Worksheets("PRES_START").Range("J20:J23").Value
Worksheets("PRESCRIPTION").Range("H51:H54").Value = Worksheets("PRES_START").Range("K20:K23").Value
 
 
 
    End If
 
End Sub

Au plaisir.

06/08/2019, 21h04
Pierre Fauconnier

Sorry, c'était mon premier code, et j'ai loupé le copier-coller du second...

Ceci devrait mieux fonctionner (préfixer la feuille pour spécifier le classeur qui la contient)

Code:

If Not Intersect(target, Range("W2")) Is Nothing And ActiveSheet = ThisWorkbook.Worksheets("recherche") Then

Si pas ok, donne le message d'erreur, ça aide... ;)

Salut,

Sa ne marche malheureusement toujours pas. Pour info, mon code se trouve dans la feuil1(recherche).

Code:

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
Private Sub Worksheet_Calculate()
    Dim target As Range
    Set target = Range("W2")
 
    If Not Intersect(target, Range("W2")) Is Nothing And ActiveSheet = ThisWorkbook.Worksheets("recherche") Then
 
 
Worksheets("PRESCRIPTION").Range("J52:J55").Value = Worksheets("PRES_START").Range("N6:N9").Value
Worksheets("PRESCRIPTION").Range("L52:L55").Value = Worksheets("PRES_START").Range("C6:C9").Value
Worksheets("PRESCRIPTION").Range("M52:M55").Value = Worksheets("PRES_START").Range("R6:R9").Value
Worksheets("PRESCRIPTION").Range("U52:U55").Value = Worksheets("PRES_START").Range("F6:F9").Value
Worksheets("PRESCRIPTION").Range("V52:V55").Value = Worksheets("PRES_START").Range("P6:P9").Value
Worksheets("PRESCRIPTION").Range("W52:W55").Value = Worksheets("PRES_START").Range("Q6:Q9").Value
Worksheets("PRESCRIPTION").Range("A66").Value = Worksheets("PRES_START").Range("FB2").Value
Worksheets("PRESCRIPTION").Range("C91").Value = Worksheets("PRES_START").Range("CN2").Value
Worksheets("PRESCRIPTION").Range("J91").Value = Worksheets("PRES_START").Range("AF2").Value
Worksheets("PRESCRIPTION").Range("A60:A63").Value = Worksheets("PRES_START").Range("E13:E16").Value
Worksheets("PRESCRIPTION").Range("C60:C63").Value = Worksheets("PRES_START").Range("F13:F16").Value
Worksheets("PRESCRIPTION").Range("E60:E63").Value = Worksheets("PRES_START").Range("H13:H16").Value
Worksheets("PRESCRIPTION").Range("G60:G63").Value = Worksheets("PRES_START").Range("O13:O16").Value
Worksheets("PRESCRIPTION").Range("I60:I63").Value = Worksheets("PRES_START").Range("K13:K16").Value
Worksheets("PRESCRIPTION").Range("A51:A54").Value = Worksheets("PRES_START").Range("C20:C23").Value
Worksheets("PRESCRIPTION").Range("B51:B54").Value = Worksheets("PRES_START").Range("D20:D23").Value
Worksheets("PRESCRIPTION").Range("C51:C54").Value = Worksheets("PRES_START").Range("F20:F23").Value
Worksheets("PRESCRIPTION").Range("D51:D54").Value = Worksheets("PRES_START").Range("G20:G23").Value
Worksheets("PRESCRIPTION").Range("E51:E54").Value = Worksheets("PRES_START").Range("H20:H23").Value
Worksheets("PRESCRIPTION").Range("F51:F54").Value = Worksheets("PRES_START").Range("I20:I23").Value
Worksheets("PRESCRIPTION").Range("G51:G54").Value = Worksheets("PRES_START").Range("J20:J23").Value
Worksheets("PRESCRIPTION").Range("H51:H54").Value = Worksheets("PRES_START").Range("K20:K23").Value
 
 
 
    End If
 
End Sub

Au plaisir

06/08/2019, 21h12
Pierre Fauconnier

Message d'erreur?

De mon côté, ça fonctionne, mais je sais difficilement me placer dans la même situation que toi.
06/08/2019, 21h14
Pierre Fauconnier

Sorry, j'ai voulu corriger sans reprendre mon code... (Changer = en Is)

Code:

If Not Intersect(target, Range("W2")) Is Nothing And ActiveSheet Is ThisWorkbook.Worksheets("recherche") Then

Désolé pour ces contretemps. J'espère que cela fonctionne, maintenant.
06/08/2019, 21h26
Justine B

Sa fonctionne très bien maintenant. Merci beaucoup!
06/08/2019, 21h27
Pierre Fauconnier

De rien. Désolé pour mes erreurs de manip ;)

Code "worksheet_change" ne fonctionne pas

Bonjour,

J'essai d'utiliser la fonction "worksheet_change" mais celle-ci ne se déclanche pas. Je n'ai pas d'erreur, donc je présume que le code ne se lance simplement pas.
Code:

1 2 3 4 5 6 7 8 9 Private Sub Worksheet_Change(ByVal Target As Range) If Target.adress = Range("G51:G54") And ActiveSheet Is ThisWorkbook.Worksheets("PRESCRIPTION") Then Worksheets("PRESCRIPTION").Range("H51:H54").Formula = Worksheets("PRESCRIPTION").Range("AF51:AF54").Formula End If End Sub
Au plaisir

Bonjour,

Adress avec 2 d: Address
And ActiveSheet Is ThisWorkbook.Worksheets("PRESCRIPTION") inutile puisque la commande se fait à partir de la feuille "PRESCRIPTION"

Le code, si j'ai bien compris
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("G51:G54")) Is Nothing Then Worksheets("PRESCRIPTION").Range("H51:H54").Formula = Worksheets("PRESCRIPTION").Range("AF51:AF54").Formula End If Application.EnableEvents = True End Sub
Cdlt

07/08/2019, 17h22
Pierre Fauconnier

On comprend mieux l'utilité de And ActiveSheet Is ThisWorkbook.Worksheets("PRESCRIPTION") après la fusion des discussions... ;)

Mets un point d'arrêt (F9 sur la ligne) sur Worksheet_Change. Ca te permettra déjà de voir si l'événement est intercepté. Si le code s'arrête sur la ligne (en jaune), avance avec F8 pour contrôler l'exécution du code.

Et pour éviter l'erreur soulignée par Arthuro, avant d'exécuter ton code, compile-le (Débogage -> Compiler VBAProject). Ta faute de frappe sur Adress aurait été relevée.
07/08/2019, 17h27
Justine B

Merci à vous deux pour la correction de mon code et pour les astuces.