Sub diff()
    Dim d1&, d2&, S&, R&, PS&, d_ As Range
    Dim lFirstRow As Long, lFirstCol As Long, rFndRng As Range, sh As Worksheet
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    R = Worksheets("Дефицит").Range("D" & Rows.Count).End(xlUp).Row + 1
'    Worksheets("Дефицит").Select
    
'    Range("A3:V" & R).Select
    Worksheets("Дефицит").Range("A3:V" & R).ClearContents
    
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "План" And sh.Name <> "Литье" And sh.Name <> "Дефицит" Then
            With sh
'                Worksheets("О23").Select
                .Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
                d1 = .Range("B" & Rows.Count).End(xlUp).Row
                d2 = .Cells(18, Columns.Count).End(xlToLeft).Column
                If .UsedRange.Cells(15, 1) = "ОМТС" Then
                    lFirstRow = .UsedRange.Row
                    lFirstCol = .UsedRange.Column
                Else
                    Set rFndRng = .UsedRange.Find("ОМТС", , xlFormulas, xlWhole)
                    lFirstRow = rFndRng.Row: lFirstCol = rFndRng.Column
                End If
                Set d_ = .Range(.Cells(15, lFirstCol), .Cells(15, d2))
                If d_(1).ColumnWidth Then
                    c_ = d_.Cells.Count
                    n_ = .Range("N3")
                    d_.EntireColumn.Hidden = False
                    For i = 1 To c_
                        If d_(i) <> "Диф." Then
                            d_(i).ColumnWidth = 0
                        End If
                    Next i
                End If
'                Worksheets("О23").Select
                For i = 18 To d1
                    If .Range("B" & i).Value = 60 Then
                        .Range(.Cells(i, 1), .Cells(i, d2)).SpecialCells(xlCellTypeVisible).Copy
'                        Selection.SpecialCells(xlCellTypeVisible).Select
'                        Selection.Copy
'                        Worksheets("Дефицит").Select
                        
                        PS = Worksheets("Дефицит").Range("D" & Rows.Count).End(xlUp).Row + 1
                        Worksheets("Дефицит").Range("A" & PS).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
'                        Worksheets("О23").Select
                    End If
                Next i
                
'                Worksheets("О23").Select
                d_.EntireColumn.Hidden = False
                Sheets("Дефицит").Select
            End With
        End If
    Next sh
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
    Application.DisplayAlerts = True
End Sub

Sub sbor()
  Dim shi_ As Worksheet
  Application.ScreenUpdating = 0
  For Each shi_ In ThisWorkbook.Worksheets
    If shi_.Name <> "План" And shi_.Name <> "Дефицит" And shi_.Name <> "Литье" Then
       With shi_
         S = .Columns("G:DD").Find("*Производитель*", [G1], SearchDirection:=xlPrevious).Row
         K = .Columns("G:DD").Find("*Производитель*", [G1], SearchDirection:=xlPrevious).Column
         PK = .Cells(16, Columns.Count).End(xlToLeft).Column
         For I = PK To 7 Step -1
           If Trim(.Cells(S - 1, I)) <> "Диф." And Trim(.Cells(S, I)) <> "Стоим. б/ндс" And Trim(.Cells(S, I)) <> "Производитель" Then
             .Columns(I).EntireColumn.Hidden = True
           End If
         Next
         R = .Range("B" & Rows.Count).End(xlUp).Row
         For I = R To 18 Step -1
           If Trim(.Cells(I, 2)) = 60 And Trim(.Cells(I, K)) <> "" Then
           Else
             .Rows(I).EntireRow.Hidden = True
           End If
         Next
         PK = .Cells(S - 1, Columns.Count).End(xlToLeft).Column
         PS = Range("B" & Rows.Count).End(xlUp).Row + 1
         S = S + 2
         Range(.Cells(S, "B"), .Cells(R, PK)).SpecialCells(xlVisible).Copy Range("B" & PS)
         .Rows(S & ":" & R).EntireRow.Hidden = False
         .Columns("F:GG").EntireColumn.Hidden = False
       End With
    End If
  Next shi_
  Application.ScreenUpdating = 1
End Sub