Private Sub CommandButton1_Click()

    On Error Resume Next
    
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "Отчёты\"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls*),", , _
    "Введите имя файла для сохраняемого отчёта", "Сохранить")
    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
    ' добавляем расширение
    Filename = Filename & "xls"
    
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа
    
    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
        
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
End Sub

Private Sub CommandButton1_Click()
    
    Dim strFilename As String
    
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "Отчёты"
    ' создаём папку для файла, если её ещё нет
    If Dir(ThisWorkbook.Path & "\" & REPORTS_FOLDER, vbDirectory) = "" Then
        MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    End If
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    
    ' вывод диалогового окна для запроса имени сохраняемого файла
    With Application.FileDialog(msoFileDialogSaveAs)
        .FilterIndex = 4
        .InitialFileName = "отчёт.xls"
        .Title = "Введите имя файла для сохраняемого отчёта"
        If .Show = 0 Then
            Exit Sub
        End If
        strFilename = .SelectedItems(1)
    End With
    
    ' копируем активный лист (при этом создаётся новая книга)
    ActiveSheet.Copy
    ' сохраняем файл под заданным именем в формате Excel 2003
    ActiveWorkbook.SaveAs strFilename, xlWorkbookNormal
    ' закрываем сохранённый файл
    ' (удалите следующую строку, если закрывать созданный файл не требуется)
    ActiveWorkbook.Close False
    
End Sub