erreur code VBA Selectionchange

**Justine B** · 02/08/2019, 13h12

Bonjour,

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

Code :

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

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 :

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
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

**Menhir** · 02/08/2019, 13h21

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 :

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

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 :

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

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

**Westood5** · 02/08/2019, 13h24

Bonjour,

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

Code :

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

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

**Justine B** · 02/08/2019, 13h35

Merci beaucoup, ça fonctionne comme un charme!

**Justine B** · 06/08/2019, 19h23

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 :

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
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.

**Pierre Fauconnier** · 06/08/2019, 20h21

Salut

Essaie avec

Code :

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

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

**Justine B** · 06/08/2019, 20h35

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 :

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
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.

**Pierre Fauconnier** · 06/08/2019, 21h04

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 :

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

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

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

**Justine B** · 06/08/2019, 21h11

Salut,

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

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
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

**Pierre Fauconnier** · 06/08/2019, 21h12

Message d'erreur?

De mon côté, ça fonctionne, mais je sais difficilement me placer dans la même situation que toi.

**Pierre Fauconnier** · 06/08/2019, 21h14

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

Code :

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

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.

**Justine B** · 06/08/2019, 21h26

Sa fonctionne très bien maintenant. Merci beaucoup!

**Pierre Fauconnier** · 06/08/2019, 21h27

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

**Justine B** · 07/08/2019, 16h48

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 :

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

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

**ARTURO83** · 07/08/2019, 17h10

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 :

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

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

**Pierre Fauconnier** · 07/08/2019, 17h22

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.

**Justine B** · 07/08/2019, 17h27

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

erreur code VBA Selectionchange [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager