Sub Макрос1()
Dim wb As Workbook, s$
     Range("AJ3:BU36").Copy
     Set wb = Workbooks.Add
     Cells(1, 1).PasteSpecial Paste:=xlPasteValues: Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
     s = GetFolderPath
     s = s & InputBox("Имя файла")
     s = s & ".xlsx"
     wb.SaveAs Filename:=s, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
     wb.Close
End Sub
Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                        Optional ByVal InitialPath As String = "c:\") As String
     ' функция выводит диалоговое окно выбора папки с заголовком Title,
     ' начиная обзор диска с папки InitialPath
     ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
     Dim PS As String: PS = Application.PathSeparator
     With Application.FileDialog(msoFileDialogFolderPicker)
         If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
         .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
         If .Show <> -1 Then Exit Function
         GetFolderPath = .SelectedItems(1)
         If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
     End With
End Function