For Each Sh_ In ActiveWorkbook.Sheets
If Sh_.Name = "Лист1" Then
Application.DisplayAlerts = 0
p_ = "C:\Users\Администратор\Desktop\Заказы\"
Sh_.Select
A:
Shn_ = InputBox("Введи номер", "Как сохранять будем?", "заказ_№_"
On Error Resume Next
gg_ = Dir(p_ & Shn_ & ".txt", vbNormal)
If gg_ <> "" Then MsgBox "Такой файл уже есть": GoTo A
ActiveWorkbook.SaveAs Filename:=p_ & Shn_ & ".txt", FileFormat:=xlTxt
If Err.Number <> 0 Then MsgBox "Нет пути " & p_
On Error GoTo 0
ActiveSheet.Name = "Лист1"
Application.DisplayAlerts = 1
End If
Next
'
End Sub

Dim lr As Long
 With Application
 .ScreenUpdating = 0
 lr = Sheets("Лист3".Cells(Rows.Count, 2).End(xlUp).Row + 1
 Sheets("Лист2".[C84:E84].Copy
 Sheets("Лист3".Range("B" & lr & "" & lr + 0).PasteSpecial
 .ScreenUpdating = 0
 
 End With
End Sub

Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [F2:F25].Cells
If cell.Find("*", , xlValues, xlPart) Is Nothing Then
cell.EntireRow.Hidden = True
End If
Next cell

Dim rng As Range 
Set rng = Range("b3,b4,b6,d3,d4,d6")
rng.EntireRow.Hidden = False 
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 
rng.SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = False

Dim lr As Long
    With Application
      .ScreenUpdating = 0
      lr = Sheets("заказ".Cells(Rows.Count, 20).End(xlUp).Row + 1
      Sheets("база корпуса".[L2:T11].Copy
      Sheets("заказ".Range("T" & lr & ":AB" & lr + 10).PasteSpecial
     .ScreenUpdating = 0
    End With
'
End Sub

For Each cell In Selection
     cell.Formula = cell.Value
    Next cell
   
'
End Sub