Excel: macro to export worksheet as CSV file without leaving my current Excel sheet

Question

There are a lot of questions here to create a macro to save a worksheet as a CSV file. All the answers use the SaveAs, like this one from SuperUser. They basically say to create a VBA function like this:

Sub SaveAsCSV()
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

This is a great answer, but I want to do an export instead of Save As. When the SaveAs is executed it causes me two annoyances:

• My current working file becomes a CSV file. I'd like to continue working in my original .xlsm file, but to export the contents of the current worksheet to a CSV file with the same name.
• A dialog appears asking me confirm that I'd like to rewrite the CSV file.

Is it possible to just export the current worksheet as a file, but to continue working in my original file?

Halakah

I think you would need to create a workbook, copy your sheet over, save as csv and close the workbook. – Aldin

@gtwebb: can you help me? My vba knowledge is really rudimentary. – Halakah

Use the 2nd answer by "SeanC" in this question: #26179413 – Malformation

Don't use the workbook functionality. Create and write a text file as per Tony Dallimore's answer. – Meyers

Try this exceldevelopmentplatform.blogspot.com/2019/08/… – Madson

Answer 1

Almost what I wanted @Ralph, but here is the best answer, because it solves some annoyances in your code:

1. it exports the current sheet, instead of just the hardcoded sheet named "Sheet1";
2. it exports to a file named as the current sheet
3. it respects the locale separation char.
4. You continue editing your xlsx file, instead of editing the exported CSV.

To solve these problems, and meet all my requirements, I've adapted the code from here. I've cleaned it a little to make it more readable.

Option Explicit
Sub ExportAsCSV()
 
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
     
    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy
 
    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With        

    Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
     
    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Note some characteristics of the code above:

1. It works just if the current filename has 4 letters, like .xlsm. Wouldn't work in .xls excel old files. For file extensions of 3 chars, you must change the - 5 to - 4 when setting MyFileName in the code above.
2. As a collateral effect, your clipboard will be substituted with current sheet contents.

Edit: put Local:=True to save with my locale CSV delimiter.

Halakah

1. TempWB.Close False should be TempWB.Close SaveChanges:=False, docs 3. Change the 5 in Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) will make it work with .xls docs Maybe we shall use regex to remove the file extension but seems too much work for a throw-away script – Compact

@KuN: What the change in TempWB.close does? – Halakah

I think that's a "lost-in-the-translation" issue, if you look into the docs link i provided or in @Raplh's answer, you shall see that's the right way to call Workbook.Close – Compact

This is great, I just added one little thing, the pastespecial xlPasteFormats so my dates stay as dates :D With TempWB.Sheets(1).Range("A1") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats End With – Worriment

great tip @CraigLambie, just added it to the original code – Halakah

What about if I need CSV UTF8 format? Seems that only office 35 support it.. How is possible?? – Vicarage

I modified the "Copy" line so it would not include hidden rows and columns. I often hide unnecessary stuff before creating a csv. ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy – Electrolytic

if i need to specify which columns must copy, how i can do? i tried to change the range parameter, but not worked. – Gerrit

Answer 2

@NathanClement was a bit faster. Yet, here is the complete code (slightly more elaborate):

Option Explicit

Public Sub ExportWorksheetAndSaveAsCSV()

Dim wbkExport As Workbook
Dim shtToExport As Worksheet

Set shtToExport = ThisWorkbook.Worksheets("Sheet1")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                       'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False

End Sub

Argeliaargent

If I need CSV in UTF8 format, why some excel version doesn't support it? Ot seems strange and a big issue – Vicarage

to get UTF8, use FileFormat:=xlCSVUTF8 in the SaveAs call. – Said

Answer 3

As per my comment on @neves post, I slightly improved this by adding the xlPasteFormats as well as values part so dates go across as dates - I mostly save as CSV for bank statements, so needed dates.

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    'Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Worriment

Would love this as an Add-in, anyone got time to make that happen? – Worriment

I have to do this for mac, but I don't have one to test. Will it work? is it OS agnostic? – Koblick

Sorry @horaciux I also don't have a mac. From memory there is very limited coding available on older versions of excel for mac... That might have changed, not sure tbh. – Worriment

Answer 4

Here is a slight improvement on the this answer above taking care of both .xlsx and .xls files in the same routine, in case it helps someone!

I also add a line to choose to save with the active sheet name instead of the workbook, which is most practical for me often:

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, InStrRev(CurrentWB.Name, ".") - 1) & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"


    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Parsons

Answer 5

For those situations where you need a bit more customisation of the output (separator or decimal symbol), or when you have a large dataset (over 65k rows), I wrote the following:

Option Explicit

Sub rng2csv(rng As Range, fileName As String, Optional sep As String = ";", Optional decimalSign As String)
'export range data to a CSV file, allowing to chose the separator and decimal symbol
'can export using rng number formatting!
'by Patrick Honorez --- www.idevlop.com
    Dim f As Integer, i As Long, c As Long, r
    Dim ar, rowAr, sOut As String
    Dim replaceDecimal As Boolean, oldDec As String
    
    Dim a As Application:   Set a = Application
    
    ar = rng
    f = FreeFile()
    Open fileName For Output As #f
    
    oldDec = Format(0, ".")     'current client's decimal symbol
    replaceDecimal = (decimalSign <> "") And (decimalSign <> oldDec)
    
    For Each r In rng.Rows
        rowAr = a.Transpose(a.Transpose(r.Value))
        If replaceDecimal Then
            For c = 1 To UBound(rowAr)
                'use isnumber() to avoid cells with numbers formatted as strings
                If a.IsNumber(rowAr(c)) Then
                    'uncomment the next 3 lines to export numbers using source number formatting
'                    If r.cells(1, c).NumberFormat <> "General" Then
'                        rowAr(c) = Format$(rowAr(c), r.cells(1, c).NumberFormat)
'                    End If
                    rowAr(c) = Replace(rowAr(c), oldDec, decimalSign, 1, 1)
                End If
            Next c
        End If
        sOut = Join(rowAr, sep)
        Print #f, sOut
    Next r
    Close #f

End Sub

Sub export()
    Debug.Print Now, "Start export"
    rng2csv shOutput.Range("a1").CurrentRegion, RemoveExt(ThisWorkbook.FullName) & ".csv", ";", "."
    Debug.Print Now, "Export done"
End Sub

Borrow

Thanks, Patrick. Can you please explain what a.Transpose(a.Transpose(r.Value)) achieves? – Dioptometer

@Dioptometer the 'double transpose' is used to transform a 2D array into a 1D array. It is necessary to have a 1D array for the Join to work. – Borrow

Answer 6

1. You can use Worksheet.Copy with no arguments to copy the worksheet to a new workbook. Worksheet.Move will copy the worksheet to a new workbook and remove it from the original workbook (you might say "export" it).
2. Grab a reference to the newly created workbook and save as CSV.
3. Set DisplayAlerts to false to suppress the warning messages. (Don't forget to turn it back on when you're done).
4. You will want DisplayAlerts turned off when you save the workbook and also when you close it.

    wsToExport.Move

    With Workbooks
        Set wbCsv = .Item(.Count)
    End With

    Application.DisplayAlerts = False
    wbCsv.SaveAs xlCSV
    wbCsv.Close False
    Application.DisplayAlerts = True

Beeeater

Answer 7

As I commented, there are a few places on this site that write the contents of a worksheet out to a CSV. This one and this one to point out just two.

Below is my version

• it explicitly looks out for "," inside a cell
• It also uses UsedRange - because you want to get all of the contents in the worksheet
• Uses an array for looping as this is faster than looping through worksheet cells
• I did not use FSO routines, but this is an option

The code ...

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long

myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile

myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
    outStr = ""
    For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
        If InStr(1, myArr(iLoop, jLoop), ",") Then
            outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
        Else
            outStr = outStr & myArr(iLoop, jLoop) & ","
        End If
    Next jLoop
    If InStr(1, myArr(iLoop, jLoop), ",") Then
        outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
    Else
        outStr = outStr & myArr(iLoop, UBound(myArr, 2))
    End If
    Print #iFile, outStr
Next iLoop

Close iFile
Erase myArr

End Sub

Meyers