Coloration dynamique de cellule

Bonjour,

A partir d'une colonne A contenant une liste de mot, mon objectif est de parcourir chacun de ces mots et de demander à l'utilisateur s'ils sont courants ou pas, s'ils le sont ils sont copiés dans une colonne D qui se colorie au fil des copies.

Je voudrais que pour chaque mot/cellule sélectionné(e), celle-ci s'affiche en couleur et que dans le même temps, un MsgBox s'affiche demandant à l'utilisateur si le mot est courant ou pas, and so on (seule la cellule sélectionnée doit être colorée).

Ma macro marche, mais lorsque l'utilisateur clique sur "Non" le MsGbox réapparaît et il faut à nouveau cliquer sur "Non" pour que le mot soit effectivement copié dans D. Idem, pour "Annuler", sauf que là, la fenêtre réapparait 3 fois avant que la procédure s'arrête effectivement. Comment faire pour qu'un seul clique suffise ?

Voici ma macro:

Private Sub identifier_Click()

Dim I As Integer
Dim J As Integer

I = 1
J = 1

Do While (Cells(I, 1) <> "//")
    Cells(I, 1).Interior.ColorIndex = 6
    If MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant") = vbYes Then
             Cells(J, 4) = Cells(I, 1)
                        Set OldRange = Cells(I, 1)
                             OldRange.Interior.ColorIndex = xlColorIndexNone
                             Cells(I + 1, 1).Interior.ColorIndex = 6
                                  Cells(J, 4).Interior.ColorIndex = 24
                                      J = J + 1

    ElseIf MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant") = vbNo Then
                    Cells(I + 1, 1).Interior.ColorIndex = 6
                    Set OldRange = Cells(I, 1)
                                    OldRange.Interior.ColorIndex = xlColorIndexNone

    ElseIf MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant") = vbCancel Then
                           Exit Do
      End If

         I = I + 1
    Loop

End Sub

Merci d'avance pour votre aide

Bonjour,

Private Sub identifier_Click()
Dim I As Integer, J As Integer, Reponse As Integer
Dim OldRange As Range
    I = 1: J = 1
    Do While (Cells(I, 1) <> "//")
        Cells(I, 1).Interior.ColorIndex = 6
        Reponse = MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant")
        If Reponse = vbYes Then
            Cells(J, 4) = Cells(I, 1)
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Cells(J, 4).Interior.ColorIndex = 24
            J = J + 1
        ElseIf Reponse = vbNo Then
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
        ElseIf Reponse = vbCancel Then
            Exit Do
        End If
        I = I + 1
    Loop
End Sub

A+

Merci beaucoup, j'ai compris mon erreur (VBA considérait mon MsgBox comme étant distinct pour mes trois cas, ce que ta variable "réponse" à changer)

Bonne fin de journée!