Excel VBA: Copy Data From Excel to NEW .csv File

What VBA code do I need to copy a given range in Excel and paste it into a newly created .csv file in csv format?

*Data From=  "C10:AA5000" in "Sheet1" of a workbook titled: "FileWithData.xlsm"
*Data To= "C:\FileStorage\ImportedData.csv" <--Does not exist yet, must be created
Who is Participating?

pls try
Sub writeCSV()
' REFERENCE MIcrosoft ActiveX DataObjects
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset

    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    strFile = Workbooks("FileWithData.xlsm").FullName

    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & _
            ";Extended Properties = 'Excel 12.0 Xml;HDR=NO';"

    cn.Open strCon
    strRange = "C10:AA5000"
    strSQL = "SELECT * FROM [Sheet1$" & strRange & "] AS T1"
    rs.Open strSQL, cn
    strData = rs.GetString(, , ",", Chr(10))
    strData = Left(strData, Len(strData) - 1)
    Debug.Print strData
    Set rs = Nothing: Set cn = Nothing
    ff = FreeFile
    Open "C:\temp\ImportedData.csv" For Output As #ff
    Print #ff, strData

    Close #ff
End Su

Open in new window

Fabrice LambertFabrice LambertCommented:

The following should work:
Option Explicit

Public Sub export()
    Const workbookName As String = "FileWithData.xlsm"
    Const worksheetName As String = "Sheet1"
    Const rangeAddress As String = "C10:AA5000"
    Const csvPath As String = "C:\FileStorage\ImportedData.csv"
    Dim wb As Excel.Workbook
    Set wb = Workbooks(workbookName) 
    Dim ws As Excel.Worksheet
    Set ws = wb.Worksheets(worksheetName)
    Dim rng As Excel.Range
    Set rng = ws.Range(rangeAddress)
    exportRangeToCsv rng, csvPath
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

Public Sub exportRangeToCsv(ByRef rng As Excel.Range, ByVal filePath As String)
    Const ForWriting As Long = 2
    Dim fso As Object   '// Scrpting.FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim stream As Object    '// Scripting.TextStream
    Set stream = fso.OpenTextFile(filePath, ForWriting, True)
    Dim row As Excel.Range
    For Each row In rng.Rows
        Dim data As String
        data = vbNullString
        Dim cell As Excel.Range
        For Each cell In row.Cells
            If (data <> vbNullString) Then
                data = data & "," & cell.Value
                data = cell.Value
            End If
        stream.WriteLine data
    Set stream = Nothing
    Set fso = Nothing
End Sub

Open in new window

Open the workbook holding data prior to calling the export procedure if needed.
ouestqueAuthor Commented:
Awesome and efficient as always! Thanks RGonzo!!!
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.