Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim WorkRange As Range, CrossRange As Range
    Set WorkRange = Range("B6:AB17")  
    If Target.Cells.Count > 1 Then
        WorkRange.FormatConditions.Delete
        Exit Sub
    End If
    Application.ScreenUpdating = False
    
    If Intersect(Target, WorkRange) Is Nothing Then
        WorkRange.FormatConditions.Delete
        Exit Sub
    End If
    
    On Error Resume Next
        Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
        WorkRange.FormatConditions.Delete
        CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
        CrossRange.FormatConditions(1).Interior.ColorIndex = 4
        Target.FormatConditions.Delete
        
End Sub
 

Sub макрос3()
    Sheets("Реестр").PivotTables("Реестр").PivotCache.Refresh
    
    ActiveSheet.PivotTables("Реестр").PivotFields("дата договора").PivotFilters. _
        Add Type:=xlDateBetween, Value1:=Format([B1].Value, "#####"), Value2:=Format([C1].Value, "#####")
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Quit

Select Case MsgBox("Вы действительно хотите завершить работу?", vbYesNo, "Выход")
    Case vbYes
        ThisWorkbook.Close True
    Case vbNo
        ThisWorkbook.Save
End Select
        
End Sub

Sub ClearFiltr()
Dim f As Range, wr As Range
Set wr = Range("A3:K3")
 Set f = wr.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart)
    If f Is Nothing Then
        MsgBox "Фильтр не применялся", vbCritical
    Else
        f.ClearContents
        MsgBox "Условия фильтра удалены", vbInformation
    End If
Range("A3").Select
End Sub

Set cel = Columns(1).Find(What:=x_text, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole)