Bonjour,
Essayez en remplaçant tout votre code dans la feuille Classe 1 par celui ci-dessous
Option Explicit
Dim stpevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim ZoneChange As Range
If stpevt = True Then Exit Sub
Set ZoneChange = Range("H10:H44")
If Not Application.Intersect(ZoneChange, Range(Target.Address)) Is Nothing Then
Application.ScreenUpdating = False
For i = 10 To 44
If Cells(i, 9).Value = "" Or Cells(i, 9).Value = "1" Then
Cells(i, 26).Value = "": Cells(i, 27).Value = "": Cells(i, 28).Value = "": _
Cells(i, 30).Value = "": Cells(i, 31).Value = "": _
Cells(i, 33).Value = "": Cells(i, 34).Value = "": Cells(i, 35).Value = ""
End If
If Cells(i, 9).Value = "2" Then
Range(i, 26).Value = "ü": Cells(i, 27).Value = "ü": Cells(i, 28).Value = "ü": _
Cells(i, 30).Value = "ü": Cells(i, 31).Value = "ü": _
Cells(i, 33).Value = "ü": Cells(i, 34).Value = "ü": Cells(i, 35).Value = "ü"
End If
Next i
Application.ScreenUpdating = True
End If
If Not Intersect(Target, Range("I10:I" & Range("B" & Rows.Count).End(xlUp).Row)) Is Nothing Then
If Target.Value = 2 Then
Application.ScreenUpdating = False
stpevt = True
Dim plage As Range, cel As Range
Set plage = Union(Range("Z10:AB10"), Range("AD10:AE10"), Range("AG10:AI10"))
For Each cel In plage
With cel
.Font.Name = "Wingdings"
.Font.Size = 20
If .Value = "" Then .Value = "ü"
End With
Next cel
stpevt = False
End If
Application.ScreenUpdating = True
End If
End Sub
Je n'ai considéré que le cas chiffre 2 comme expliqué dans votre demande. Pour effacer c'est le double click dans chaque cellule qui le fait
Cordialement