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

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?

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

@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

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

For those situations where you need a bit more customisation of the output (separator or decimal symbol), or who have 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

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