Macro s'executant à chaque changement et crash

Version imprimable

Bonjour,

Je suis assez débutant dans le language VBA (je suis plus familier avec python) et je cherche à réaliser une feuille excel dans laquelle les trois premiers champs (par ex A1, B1 et C1) serait destiné à écrire des informations qui seraient reporter automatiquement à un endroit spécifique dans ma feuille à la suite d'autres. Par exemple, si j'écris "Jules" en A1 il va se reporter en D23 avant de disparaitre de la case. Si je réécris "Vernes" dans la case A1, il va se reporter en D24 avant de disparaitre de A1. Problème: dès que je remplis la case A1, ça se reporte là où je veux, ça disparait de A1 mais mon Excel crash ! Voici mon code que je rentre dans visualiser le code en clique droit sur la feuille Excel:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Range("A1:C1") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then derniereLigne = Cells(Rows.Count, 5).End(xlUp).Row + 1 Dim valeura As String valeura = Cells(1, 1) Cells(derniereLigne, 5) = valeura Range("A1").Clear End If End Sub
C'est un code assez basique pour l'instant mais comme ça ne marche pas déjà pas sans crash.. N'ayant pas les connaissances nécessaires dans le domaines, j'espère que vous saurez m'aider !

Merci pour votre lecture,
Lucas

Bonjour,

Cela vient du fait que les instructions relancent la routine Worksheet_Change. Une solution:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim derniereLigne As Long
    Dim valeura As String
    Set KeyCells = Range("A1:C1")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        derniereLigne = Cells(Rows.Count, 5).End(xlUp).Row + 1
        valeura = Cells(1, 1)
        Application.EnableEvents = False  '--- sans cela, les 2 instructions suivantes relanceront Worksheet_Change
        Cells(derniereLigne, 5) = valeura
        Range("A1").Clear
        Application.EnableEvents = True
    End If
End Sub

Cordialement.

23/07/2022, 15h51
Lucayanokouji

Merci pour le temps que tu as pris pour m'aider Eric ! Ce changement me permet de faire ce que je veux précisément :)

Je vais aller me renseigner plus amplement sur les différentes instructions que j'ai utilisées pour mieux comprendre leur fonctionnement !

Cordialement,
Lucas