VBA to save a selected area as CSV

keranali

Rules Violation
Joined
Oct 4, 2010
Messages
234
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,

Is there a VBA to save a selected number of cells as a CSV file allowing the save as dialog box to open and to allow a file location. When finished saving the CSV file opens.


Thanks
K
 
Last edited:

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
I would run the macro recorder to select the cells, open a new workbook, copy the selected cells to the new workbook and then save the new workbook

then I would adjust the recorded macro to make it more generic
 
Upvote 0
Ok Thanks I got this so far how do you allow the save dialog box to open.

Code:
     Range("C1:N25").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\Keran\Desktop\Data01.csv" _
    , FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True

thanks
 
Upvote 0
I think I may have the code you're looking for:-
Code:
Option Explicit
 
Public Sub ExcelRowsToCSV()
 
  Dim iPtr As Integer
  Dim sFileName As String
  Dim intFH As Integer
  Dim aRange As Range
  Dim iLastColumn As Integer
  Dim oCell As Range
  Dim iRec As Long
 
  Set aRange = Application.InputBox("Select a range:-", , Selection.Address, , , , , Type:=8)
  iLastColumn = aRange.Column + aRange.Columns.Count - 1
  
  iPtr = InStrRev(ActiveWorkbook.FullName, ".")
  sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".csv"
  sFileName = Application.GetSaveAsFilename(InitialFileName:=sFileName, FileFilter:="CSV (Comma delimited) (*.csv), *.csv")
  If sFileName = "False" Then Exit Sub
    
  Close
  intFH = FreeFile()
  Open sFileName For Output As intFH
  
  iRec = 0
  For Each oCell In aRange
    If oCell.Column = iLastColumn Then
      Print #intFH, oCell.Value
      iRec = iRec + 1
    Else
      Print #intFH, oCell.Value; ",";
    End If
  Next oCell
   
  Close intFH
  
  MsgBox "Finished: " & CStr(iRec) & " records written to " _
     & sFileName & Space(10), vbOKOnly + vbInformation
 
End Sub
Any good?
 
Upvote 0
Hi thanks for the reply whit if the range is fixed C2:N25, I am also getting a runtime error 5
 
Upvote 0
I found this code from http://www.rondebruin.nl/saveas.htm

Code:
Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2010
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        FileFilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:= _
        " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        " Excel 2000-2003 Workbook (*.xls), *.xls," & _
        " Excel Binary Workbook (*.csv), *.csv", _
        FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "csv": FileFormatValue = 6
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub


which allows me to save as different extensions however its not giving me a range, How can I get a range from C2:N25

Thanks
K
 
Upvote 0
Hi thanks for the reply whit if the range is fixed C2:N25



Replace:-
Code:
Set aRange = Application.InputBox("Select a range:-", , Selection.Address, , , , , Type:=8)
with:-
Code:
Set aRange = Range("C2:N25")

I am also getting a runtime error 5

Make the change I suggested. If you still get an error, let me know which line it occurs on.
 
Upvote 0
Hello Ruddles your code work's prefect thanks very much its doing exactly what I needed it to do.

Thanks again
K
 
Upvote 0
OK one small problem I believe when I try to over write the existing file in the save dialog box I am getting a "run-time error 70 Permission Denied"

When I debug
Code:
Open sFileName For Output As intFH
is highlighted.

Is there a solution around this?

Thanks
K
 
Upvote 0
Odd, I just tested it and it overwrites the file okay if you choose an existing file.

Do you have permission to overwrite the file manually?
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top