Option Explicit
Sub test()
Dim i As Long, j As Long, W As Long, k As Long, l As Long
Application.ScreenUpdating = False
Sheets("Feuil1").Visible = True
With Sheets("Enigme d'Einstein")
W = 4
For i = 4 To 28
i = W
For l = 3 To 7
If .Cells(i, l).Interior.ColorIndex = 3 Then
.Cells(i, l).ClearContents
.Cells(i, l).Interior.ColorIndex = xlNone
Exit For
End If
Next l
Sheets("Feuil1").Select
For j = 3 To 7
If .Cells(i, j) = Cells(i, j) And Cells(i, j) = "X" And Cells(i, j) <> "" And .Cells(i, j) <> "" Then
Exit For
ElseIf Cells(i, j) <> "" And .Cells(i, j) = "" Or Cells(i, j) = "" And .Cells(i, j) <> "" Then
MsgBox "Il y a une (des) erreurs"
For k = 3 To 7
If .Cells(i, k) <> "" And .Cells(i, k) <> Cells(i, k) And Cells(i, k) = "" Then
.Cells(i, k).Interior.ColorIndex = 3
Exit For
End If
Next k
Sheets("Feuil1").Visible = False
Exit Sub
End If
Next j
W = W + 1
Next i
End With
MsgBox " Enigme CORRECT "
Sheets("Feuil1").Visible = False
Application.ScreenUpdating = True
End Sub
Sub effacer()
Dim message
message = MsgBox("Voulez-vous effacer?", vbYesNoCancel, "ATTENTION")
If message = vbYes Then
Sheets("Enigme d'Einstein").Range("C4:G28") = ""
End If
End Sub