Erreur si supprime plusieur cellules a la fois

Private Sub Worksheet_Change(ByVal Cel As Range)
If Cel.Count > 1 Then Exit Sub
If Intersect(Cel, Range("C8")) Is Nothing Then Exit Sub
If Len(Cel) > 7 Then MsgBox "ID Commerçant 7 caractères": Application.Undo
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
if Target.count > 1 then exit sub
If Target <> Range("$H$6") Then Exit Sub 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target <> ActiveSheet.Range("$H$6") Then Exit Sub
Select Case Target.Value
  Case Is = "En Cours": ActiveSheet.Tab.ColorIndex = 35
  Case Is = "Attente Action": ActiveSheet.Tab.Color = RGB(255, 0, 0)  '38
  Case Is = "Cloturé": ActiveSheet.Tab.ColorIndex = 50
End Select
End Sub