Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Application.CutCopyMode = xlCut Then
     Application.CutCopyMode = False
   End If
End Sub

Private Sub Workbook_Open()
Dim rCell As Range
Application.ScreenUpdating = False
      For Each rCell In ThisWorkbook.Sheets(1).UsedRange 'проход по всем ячейкам используемого диапазона листа 1
          If rCell .Value > 0.1 Then ' Здесь ваши условия
              rCell .Font.Color = -16777024 ' здесь ваше форматирование
              rCell .Interior.Color = 12040191
          ' Else - второй список условий и форматирование. И так далее.
          End If
      Next
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Count > 1 Or Target = Empty Then Exit Sub
     r0_ = 7
     r1_ = Range("C" & Rows.Count).End(xlUp).Row
     g = Target
     If Not Intersect(Target, Range("D" & r0_, "IL" & r1_)) Is Nothing Then
         Application.ScreenUpdating = 0
         Application.EnableEvents = 0
             r_ = WorksheetFunction.Match(Target, [Sokr], 0) + [Sokr].Row - 1
             Sheet1.Range("B" & r_).Copy Target
         Application.EnableEvents = 1
         Application.ScreenUpdating = 1
     End If
On Error GoTo 0
End Sub

If Target = Empty Then Target.ClearFormats: Exit Sub
If Target.Count > 1 Then Exit Sub

Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      Application.ScreenUpdating = 0
      Application.EnableEvents = 0
      If Not Intersect(Target, Range("D" & r0_, "IL" & r1_)) Is Nothing Then
          n_ = Target.Cells.Count
          r0_ = 7
          r1_ = Range("C" & Rows.Count).End(xlUp).Row
          For i = 1 To n_
              If Not Intersect(Target(i), Range("D" & r0_, "IL" & r1_)) Is Nothing Then
                  If Target(i) = Empty Then Target(i).ClearFormats: GoTo A
                  r_ = WorksheetFunction.Match(Target(i), [Sokr], 0) + [Sokr].Row - 1
                  Sheet1.Range("B" & r_).Copy Target(i)
A:
              End If
          Next i
      End If
      Application.EnableEvents = 1
      Application.ScreenUpdating = 1
      On Error GoTo 0
End Sub