Sub DiapazonSaveInXLFile()
    Dim iSource As Range, iFileName 'As Variant
   
    Set iSource = ActiveSheet.Range("d2:f100")
    
    With Application
         iFileName = .GetSaveAsFilename( _
         FileFilter:="Excel Files (*.CSV), *.CSV", _
         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