Сохранить вкладку как новый файл без изменений (Excel) - VBA

Формулировка задачи:

Добрый день! Помогите с макросом, который будет: 1) Удалять все строки в который есть формула, но нет значений (сейчас код просто скрывает их) 2) Удалять все формулы в листе (он уже написан см. ниже) 3) Сохранить вкладку как новый файл с определенным именем файла "Файл 1" + дата (сейчас при открытии нового файла пишет, что коррупирован и открытие его может быть не безопасно (почему?)). 4) Все это будет происходить без затрагивания исходного файла (будет создаваться временный файл или другим образом)

                    Листинг программы
                
 
                        
                          
                    
Sub DeleteRows()
    Set rr = Range("A15:O226")
    For Each cell In rr
    cell.Select
        If cell.HasFormula = True And cell.Value = "" And cell.EntireRow.Hidden = False Then Rows(cell.Row).EntireRow.Hidden = True
    Next cell
End Sub
 
Sub All_Formulas_To_Values_()
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
End Sub
 
Sub SaveAsNew()
Dim FileN$
FileN = ThisWorkbook.Path & "" & Date & ".xls"
ThisWorkbook.Sheets(5).Copy
ActiveWorkbook.SaveCopyAs FileN
ActiveWorkbook.Close SaveChanges:=False
MsgBox "Worksheet is saved as new file " & FileN
End Sub
 
Sub AllOperations()
Call DeleteRows
Call All_Formulas_To_Values_
Call SaveAsNew
End Sub

Решение задачи: «Сохранить вкладку как новый файл без изменений (Excel)»

textual
                            Листинг программы 
                        
 
                        
                          
                    
Private Sub Testv2() 'Для примера Book2.xlsm
    Dim iFileName$, iRow&
    iFileName = ThisWorkbook.Path & "\Файл1_" & Date & ".xls"
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlManual
    
    ThisWorkbook.Sheets(2).Copy
    With ActiveWorkbook.ActiveSheet
         .Buttons.Delete '.Shapes("Button 1").Delete
         .UsedRange.Value = .UsedRange.Value
         For iRow = .Cells(.Rows.Count, 2).End(xlUp).Row To 5 Step -1
             If Application.CountA(.Rows(iRow)) = 1 Then .Rows(iRow).Delete
         Next
         .SaveAs iFileName, xlExcel8: .Parent.Close
    End With
    
    Application.Calculation = xlAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub