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

Private Sub CommandButton1_Click()
Dim x As String
x = InputBox("Введите артикул, который нужно найти", "Ввод данных дя поиска")
    If x = "" Then
    MsgBox "Вы не ввели данные для поиска!", vbInformation, "ошибка"
    Exit Sub
    End If

 x_text = "*" & x & "*"

 Cells.Find(What:=x_text, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
End Sub