Private Sub CommandButton1_Click()
    Dim iSource As Range, iFileName 'As Variant
    Set iSource = ActiveSheet.Range("V3:AE500")
   
    With Application
         iFileName = .GetSaveAsFilename( _
         FileFilter:="Excel Files (*.xls), *.xls", _
         Title:="Введите имя файла и выберите место его сохранения")
         If iFileName <> False Then
            .ScreenUpdating = False
            .DisplayAlerts = False '
            With .Workbooks.Add(xlWBATWorksheet)
                 iSource.Copy Destination:=.Worksheets(1).Range("A1")
                 .Close Filename:=iFileName, saveChanges:=True
            End With
            .DisplayAlerts = True '
            .ScreenUpdating = True
         Else
            MsgBox "Для сохранения данных необходимо указать файл", , ""
         End If
    End With
End Sub