Save customrange to csv file

[Marcster]

As I am a bit rusty with VBA nowadays, need help for the below.
I need to save a range to a .csv file whereby cell I1 will hold the range (i.e. A1:C20) in text format, and the filename will be in cell I2.
I also need the user to select which folder they want the csv saved to.

Thanks,

[Toubkal]

Hi,
the idea is to copy that range and paste it in a new clean sheet that will be move to a new Workbook so you can save as CSV.

I suggest to :

1- Select that range
2- Copy it
3- Add a new Sheet within the original WrkBook
4- Paste
5- Move that sheet to new Workbook
6- Open Dialog to select a Folder
7- Save as CSV. using I1 as file name
8- Close.

Try this code: well the Order is little bit different.

Sub SaveCSV()

Dim DestFolder, File_Name As String
Dim Myrange As String
If Application.FileDialog(msoFileDialogFolderPicker).Show <> 0 Then    '<<- Open Dialog to Pick a folder
    Myrange = Range("I1").Text      '<<- get range Name from I1
    File_Name = Range("I2").Text    '<<- get File name from I2
    DestFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) ' << Get folder
    Range(Myrange).Select      '<<- Range Select
    Selection.Copy          '<<- Range Copy
    Sheets.Add After:=Sheets(Sheets.Count) '<< Add a new clean sheet at the end
    ActiveSheet.Paste       '<<- Paste selection
    Application.CutCopyMode = False
    ActiveSheet.Move        '<<- Move that new sheet to a new workbook
    ActiveWorkbook.SaveAs Filename:=DestFolder & "\" & File_Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False '<< Save as CSV
    
    Application.DisplayAlerts = False
    ActiveWindow.Close      '<< Close the new workbook
    Application.DisplayAlerts = True

End If
End Sub

[rlv]

Another example

Sub SaveExample()
    Dim WB As Workbook, R As Range, FName As String

    With ActiveSheet
        On Error GoTo AddrError
        Set R = .Range(.Range("I1").Value)
        FName = .Range("I2").Value
        On Error GoTo 0
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> 0 Then
            FName = .SelectedItems(1) & "" & FName
        Else
            Exit Sub
        End If
    End With

    Set WB = Application.Workbooks.Add
    R.Copy
    With WB
        .Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
        Application.DisplayAlerts = False
        .SaveAs Filename:=FName, FileFormat:=xlCSV
        .Close SaveChanges:=False
        Application.DisplayAlerts = True
    End With
    Exit Sub
AddrError:
    MsgBox "Invalid Range Address"
End Sub

[Marcster]

Thanks Guy's. Will try out the code tonight and let you know...

[Marcster]

Thanks guy's. Now does what I wanted.... and catching up on my VBA skills.