Sub test2()
Dim cll As Range
Dim NumberOfColors As Integer
NumberOfColors = 0
For Each cll In ActiveWorkbook.Names("Äèàïàçîí").RefersToRange.Cells
    If cll.Interior.ColorIndex = 3 Then
        NumberOfColors = NumberOfColors + 1
    End If
Next
MsgBox ("число ошибок=" & NumberOfColors)
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox (ActiveSheet.Name)
End Sub

Private Sub ComboBox1_Change()
If ActiveSheet.Name = "КАСКО" Then
    Kateg = Worksheets("Справочники").Range("$D$2879").Value
    Model = ComboBox1.Text
    Res = InStr(Model, "категория B")
    TipStrah = Worksheets("Лист1").Range("ТипСтрах").Value
    'MsgBox (Kateg & " - " & TipStrah & " - " & Res)
    If ((TipStrah = 2 Or TipStrah = 3) And ((Kateg = 149 Or Kateg = 150 Or Kateg = 151) And Res > 0) Or Kateg < 149) Then
        'Снимаем защиту листа
        ActiveSheet.Unprotect Password:="111"
        Worksheets("КАСКО").Range("$J$7").Value = "B"
        'защищаем лист
        ActiveSheet.Protect Password:="111", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Else
        'Снимаем защиту листа
        ActiveSheet.Unprotect Password:="111"
        Worksheets("КАСКО").Range("$J$7").Value = ""
        'защищаем лист
        ActiveSheet.Protect Password:="111", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If
    Worksheets("КАСКО").Range("$D$10").Value = ""
End If
End Sub