Private Sub Worksheet_Change(ByVal Target As Range)

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("2. Sheet")

a = sh.Cells(sh.Rows.Count, "D").End(xlUp).Row + 1

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

    If Not Intersect(Target, Range("B4:B" & a)) Is Nothing Then
          
        If IsEmpty(Cells(Target.Row, 2)) Then
            sh.Range("B" & Target.Row & ":F" & Target.Row).ClearContents
            GoTo flag
        End If

        With sh
            .Range("C" & Target.Row).Formula = "=""Done"""
            .Range("D" & Target.Row).Formula = "=""Done"""
            .Range("E" & Target.Row).Formula = "=""Done"""
        End With
               
    End If

flag:

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
        
End Sub

With ActiveSheet.PivotTables("branch").PivotFields("Подотдел")
    .PivotItems("10-удалДВЕР").Visible = False
    .PivotItems("15-удалНАСТЕННЫЕ").Visible = False
    .PivotItems("35-удалЗАЩИТНЫЕ").Visible = False
    .PivotItems("10-удалитьЛЮСТРЫ").Visible = False
End With

With ActiveSheet.PivotTables("branch").PivotFields("Подотдел")
    .PivotItems("*удал*").Visible = False
End With

Private Sub UserForm_Initialize()
    Me.CommandButton1 = Sheets("TOTAL").Range("J3").Text
End Sub

Public sht(1 To 7) As Worksheet

Sub analysis()

Set sht1 = ThisWorkbook.Worksheets("Анализ - 1")
Set sht2 = ThisWorkbook.Worksheets("Анализ - 2")
Set sht3 = ThisWorkbook.Worksheets("Анализ - 3")
Set sht4 = ThisWorkbook.Worksheets("Анализ - 4")
Set sht5 = ThisWorkbook.Worksheets("Анализ - 5")
Set sht6 = ThisWorkbook.Worksheets("Анализ - 6")
Set sht7 = ThisWorkbook.Worksheets("Анализ - 7")

sht(1 to 7).Visible = False 'вот тут очевидная ошибка, для примера привел

End Sub

Dim sh as Worksheet

For Each sh In ThisWorkbook.Worksheets
    On Error Resume Next
    sh.UsedRange.Value = sh.UsedRange.Value
Next sh
 

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D3:D12")) Is Nothing Then
        Application.EnableEvents = False
        If IsEmpty(Cells(Target.Row, 4)) Then
            Range("D" & Target.Row & ":K" & Target.Row).ClearContents
            Application.EnableEvents = True: Exit Sub
        End If
        With Target.Offset(0, 1)
         .FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,'R:\Source\[Список поставщиков.xlsx]Export'!C2:C6,5,0),""Не найдено"")"
        End With
        With Target.Offset(0, 2)
         .FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,'R:\Source\[Список поставщиков.xlsx]Export'!C2:C6,2,0),""Не найдено"")"
        End With
        With Target.Offset(0, 3)
         .Value = "Действующий"
        End With
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Target, Range("E3:E12")) Is Nothing Then
        Application.EnableEvents = False
        If IsEmpty(Cells(Target.Row, 5)) Then
            Range("D" & Target.Row & ":K" & Target.Row).ClearContents
            Application.EnableEvents = True: Exit Sub
        End If
        With Target.Offset(0, 2)
         .Value = "Новый"
        End With
        Application.EnableEvents = True
    End If
    

End Sub

Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range, Rng5 As Range, Rng6 As Range, mRng As Range, rCell As Range
Dim CellAd As String

Set Rng1 = Sheets("1. Карточка проекта").Range("E4:E23")
Set Rng2 = Sheets("2. Поставщики и гамма товаров").Range("B3:E600")
Set Rng3 = Sheets("2. Поставщики и гамма товаров").Range("I3:L60")
Set Rng4 = Sheets("3. Анализ поставщиков").Range("F17:F70")
Set Rng5 = Sheets("4. Анализ цен").Range("F4:F3000")
Set Rng6 = Sheets("4. Анализ цен").Range("K4:K3000")
Set mRng = Union(Rng1, Rng2, Rng3, Rng4, Rng5, Rng6)


        For Each rCell In mRng
            If rCell.DisplayFormat.Interior.Color = 65535 Then
                CellAd = "на листе '" & rCell.Parent.Name & "', ячейка " & rCell.Address(External:=False)
                MsgBox "Не заполнены данные " & CellAd
                Exit Sub
            End If
        Next

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim p As Range: Application.ScreenUpdating = False
    For Each p In [H3:H10]
        p.FormulaR1C1 = "=VLOOKUP(RC[-3],Прайс!C2:C3,2,0)"
        If IsError(p) Then p = ""
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub 'выделено больше одной ячейки
    If Not Intersect(Target, Range("G3:AK6")) Is Nothing Then
        Application.EnableEvents = False
        Select Case LCase(Target)
            Case ""
                Target = "Введите ID оборудования"
            Case "1"
                Target = "Один"
            Case "2"
                Target = "Два"
            Case "3"
                Target = "Три"
        End Select
    End If
        Application.EnableEvents = True
End Sub