Sub Replace_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
     Dim rRng As Range, rAr As Range
     On Error Resume Next
     With ActiveWindow.RangeSelection.Cells
     If .Count = 1 Or .MergeCells Then
         .Item(1) = .Item(1).Value: .Item(1).Font.Color = vbBlack: Exit Sub
     Else
         Set rRng = .SpecialCells(xlCellTypeFormulas).SpecialCells(xlCellTypeVisible)
     End If
     End With
     If rRng Is Nothing Then Exit Sub
     For Each rAr In rRng.Areas: rAr.Value = rAr.Value: Next
     rRng.Select
     rRng.Font.Color = vbBlack
End Sub

Sub область_печати()
'
' область_печати Макрос
'
'
        Application.Goto Reference:="Print_Area"
        ActiveSheet.PageSetup.PrintArea = "Print_Area"   
End Sub

Sub Мяу()
     Dim arr, nm As Name, x, arrPrintArea, i&
     arr = Sheets("АРХИВАЦИЯ").Range(Sheets("АРХИВАЦИЯ").Cells(1, 1), Sheets("АРХИВАЦИЯ").Cells(Rows.Count, 1).End(xlUp)).Value
     If Not IsArray(arr) Then arr = Array(arr)
     On Error Resume Next
     ReDim arrPrintArea(LBound(arr) To UBound(arr), 1 To 2)
     i = LBound(arr)
     For Each x In arr
         If Len(x) Then
             With ThisWorkbook.Sheets(x)
                 .UsedRange.Value = .UsedRange.Value
                 .Cells.FormatConditions.Delete
                 arrPrintArea(i, 1) = x
                 arrPrintArea(i, 2) = .PageSetup.PrintArea
                 i = i + 1
             End With
         End If
     Next
     For Each nm In ThisWorkbook.Names
         nm.Delete
     Next
     For i = LBound(arrPrintArea) To UBound(arrPrintArea)
         ThisWorkbook.Sheets(arrPrintArea(i, 1)).PageSetup.PrintArea = arrPrintArea(i, 2)
     Next
End Sub