Open Notes

Sub ToNewFile()
 pathNewBook = "C:\Temp\" 'Путь сохранения новой книги
 nameNewBook = "Название книги (" & Format(Now, "MMMM YYYY") & ").xlsx"
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.SheetsInNewWorkbook = 1 'Количество листов в новой книге
 Set NewWB = Workbooks.Add
 ThisWorkbook.Activate
 Sheets("Лист 1").Copy Before:=NewWB.Sheets(1)
 NewWB.Sheets(2).Delete
 'Удаляем кнопки
 NewWB.Sheets("Лист 1").Shapes.Range(Array("cbButtonName")).Delete
 NewWB.SaveAs Filename:=pathNewBook & nameNewBook
 NewWB.Close True 'Сохраняем
 Application.CutCopyMode = False
 If Dir(pathNewBook & nameNewBook) <> "" Then
  MsgBox "Создан файл: " & pathNewBook & nameNewBook
 Else
  MsgBox "Не удалось создать файл!"
 End If
End Sub