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

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?

Answer 1

#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

Answer 2

Almost what I wanted #Ralph, but here is the best answer, because it solves some annoyances in your code:
it exports the current sheet, instead of just the hardcoded sheet named "Sheet1";
it exports to a file named as the current sheet
it respects the locale separation char.
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:
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.
As a collateral effect, your clipboard will be substituted with current sheet contents.
Edit: put Local:=True to save with my locale CSV delimiter.

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

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

Answer 5

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

Answer 6

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).
Grab a reference to the newly created workbook and save as CSV.
Set DisplayAlerts to false to suppress the warning messages. (Don't forget to turn it back on when you're done).
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

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