Saisie automatique dans une colonne en fonction d'une autre colonne

Bonjour le forum,

Dans l’extrait de mon fichier de travail (en PJ) et afin de ne pas oublier une éventuelle saisie dans la colonne "X" si j'inscris "En cours" dans la colonne "R", j'ai voulu adapter la procédure "Private Sub Worksheet_Change(ByVal Target As Range)" de la "feuil1" mais ça ne marche pas. Est-ce que quelqu'un pourrait me dire qu'est-ce qui ne va pas dans la partie de mon module ci-dessous :

'Saisie du numéro de FUD automatiquement si souhaitez

If Target.Row < 3 Then Exit Sub

For Each fud In Target.Rows

If Me.Cells(fud.Row, 18) = "En cours" Then

réponse_fud1 = MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo)

If réponse_fud1 = vbNo Then Exit Sub

Else

num_fud = InputBox("Saisir le numéro du FUD")

Me.Cells(fud.Row, 18).Value = num_fud

End If

Next fud

La finalité est que lorsque je saisis dans la colonne "R" le mot clé "En cours" une boite de message me demande si je souhaite inscrire le numéro correspondant à ce FUD. Si réponse « NON » le test me fait sortir de la boucle et non pas de la procédure comme j'ai fait.

Si « OUI » une nouvelle fenêtre me demande de saisir le numéro du FUD (format texte) et le met directement dans la colonne X.

Cordialement

Bonjour,

Essayez ce code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Saisie du numéro de FUD automatiquement si souhaitez
If Target.Row < 3 Then Exit Sub
    If Target.Value = "En cours" Or Target.Value = "en cours" Then
        If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then
        Exit Sub
        Else
        num_fud = InputBox("Saisir le numéro du FUD")
        Me.Cells(Target.Row, 24).Value = num_fud
        End If
    End If
End Sub

Cordialement

Avec le fichier

Bonjour,

A partir du moment ou tu utilises la procédure événementielle Change(), je ne vois pas l'intérêt de faire une boucle (il te faut juste valider la première fois les quelques cellules qui ont comme valeur "En cours" et ensuite ça sera automatique) :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Row < 3 Then Exit Sub
    If Target.Column <> 18 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    If Target.Value = "En cours" Then

        If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then Exit Sub

        Application.EnableEvents = False
        Cells(Target.Row, 24).Value = InputBox("Saisir le numéro du FUD")

    End If

    Application.EnableEvents = True

End Sub

Merci à "besoin_d_aide" et à Theze. Les deux solutions fonction correctement.

Je mets le sujet en résolu. Juste une peite question complémentaire : comment je peux faire pour sortir du "if" et non pas de la procédure ? Actuellement j'ai "Exit Sub" mais je souhaiterai plutôt une sorte de "Exit If" aux lignes :

If Target.Row < 3 Then Exit Sub

If Target.Column <> 18 Then Exit Sub

If Target.Count > 1 Then Exit Sub

Car après ces lignes de commandes j'en ai d'autre qui ne s'exécutent pas si je suis sorti de la procédure.

Sinon merci encore.

Cordialement

Re,

Une possibilité est d'utiliser GoTo mais avec prudence !

Tu peux peut être nous montrer tout ton code pour voir si il n'y a pas une solution plus propre :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Row < 3 Then GoTo Reprise
    If Target.Column <> 18 Then GoTo Reprise
    If Target.Count > 1 Then GoTo Reprise

    If Target.Value = "En cours" Then

        If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then Exit Sub

        Application.EnableEvents = False
        Cells(Target.Row, 24).Value = InputBox("Saisir le numéro du FUD")

    End If

    Application.EnableEvents = True

Reprise:

    'ici ton autre code...

End Sub

Aussitôt demandé aussitôt fait 😂. J'ai intégré les deux solutions proposées dans la macro mais seulement une est activé.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range, d, t, i&, derln&

Dim num_fud As String

derln = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

'Application.EnableEvents = False

If Not Intersect(Target, Range("G3:H" & derln)) Is Nothing Then

For i = 3 To derln

If Range("G" & i) <> "" Then

If Not IsDate(Range("G" & i)) Or Not IsDate(Range("H" & i) + 1) Then

MsgBox "Date incorrecte à la ligne " & i, 16

Range("G" & i & ":H" & i).Select

Exit Sub

ElseIf Year(Range("G" & i)) < 1900 Or Year(Range("H" & i)) < 1900 Then

MsgBox "Saisie de date incorrecte à la ligne " & i, 16

Range("G" & i & ":H" & i).Select

Exit Sub

ElseIf Range("G" & i) > Range("H" & i) Then

MsgBox "Erreur de saisie à la ligne " & i & Chr(13) & _

"La date de début ne peut pas être postérieure à celle de fin.", 16

Range("G" & i & ":H" & i).Select

Exit Sub

End If

End If

Next i

End If

'Saisie du numéro de FUD automatiquement si souhaitez

If Target.Row < 3 Then Exit Sub

If Target.Value = "En cours" Or Target.Value = "en cours" Then

If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then

Exit Sub

Else

num_fud = InputBox("Saisir le numéro du FUD")

Me.Cells(Target.Row, 24).Value = num_fud

End If

End If

'If Target.Row < 3 Then Exit Sub

' If Target.Column <> 18 Then Exit Sub

' If Target.Count > 1 Then Exit Sub

' If Target.Value = "En cours" Then

' If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then Exit Sub

' Cells(Target.Row, 24).Value = InputBox("Saisir le numéro du FUD")

' End If

If Target.Row < 3 Or Target.Column < 11 Or (Target.Column > 14 And Target.Column < 19) Or Target.Column > 19 Then Exit Sub

d = Date: t = Time

For Each r In Target.Rows

If Me.Cells(r.Row, 12) <> "" Or Me.Cells(r.Row, 13) <> "" Or Me.Cells(r.Row, 14) <> "" Or Me.Cells(r.Row, 19) <> "" Then

Me.Cells(r.Row, 33).Value = d

Me.Cells(r.Row, 34).Value = t

Me.Cells(r.Row, 40).ClearContents

Else

Me.Cells(r.Row, 33).Resize(, 2).ClearContents

End If

Next r

Application.ScreenUpdating = True

'Application.EnableEvents = True

End Sub