PDA

View Full Version : [SOLVED] Save customrange to csv file



Marcster
11-21-2018, 06:25 AM
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
11-26-2018, 06:39 AM
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
11-26-2018, 08:25 AM
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
11-27-2018, 09:47 AM
Thanks Guy's. Will try out the code tonight and let you know...

Marcster
11-29-2018, 06:22 AM
Thanks guy's. Now does what I wanted.... and catching up on my VBA skills.