Copy data from existing sheet to new csv file

Question

I'm trying to create an Excel tool to split a sheet of data into multiple .csv files, to a maximum of 200 rows per csv file.

My code:

Dim CSheet As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim currentFilePath As String
Dim filePath As String
Dim dataDate As String
Dim n As Integer
Dim r As Integer
Dim rowStartNumber As Integer
Dim rowEndNumber As Integer
Dim numOfFiles As Integer


'*****************************************************
'  Declare variables
'*****************************************************
On Error Resume Next
Application.DisplayAlerts = False
Set CSheet = Worksheets("Cleaned_Data")
Worksheets("Cleaned_Data").Activate

LastRow = CSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = CSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Debug.Print (Application.ActiveWorkbook.Path)
currentFilePath = Application.ActiveWorkbook.Path

numOfFiles = (LastRow - 1) / 200

dataDate = Format(Worksheets("Instructions").Cells(14, 2), "DD-MMM-YYYY")
filePath = currentFilePath & "\" & dataDate

'*****************************************************
'  Check if folder exists; if yes delete and recreate
'*****************************************************

'if folder does not exist
If Dir(filePath, vbDirectory) = "" Then
    MkDir filePath
Else
    Kill filePath & "*.*"
    RmDir filePath
    MkDir filePath
End If


Debug.Print ("Hello")

' Loop to create the files
For n = 1 To numOfFiles
    rowStartNumber = 2 + ((n - 1) * 200)
    rowEndNumber = rowStartNumber + 199
    Debug.Print (rowStartNumber & " - " & rowEndNumber)
    For r = rowStartNumber To rowEndNumber
        Debug.Print (rowStartNumber)
        'Start to get data from Csheet, up to 200 rows, and write them into a new .csv file in filePath
    Next r
Next n

The loop section is what I'm struggling with. I've tried many ways of copying pasting, or going row by row to iterate and write the .csv file out. How can I do that using VBA?

' Loop to create the files
For n = 1 To numOfFiles
    rowStartNumber = 2 + ((n - 1) * 200) 'first data row starts at row 2, due to headers
    rowEndNumber = rowStartNumber + 199
    Debug.Print (rowStartNumber & " - " & rowEndNumber)
    For r = rowStartNumber To rowEndNumber
        Debug.Print (rowStartNumber)
        'Start to get data from Csheet, up to 200 rows, and write them into a new .csv file in filePath
    Next r
Next n

Your best bet would probably be to create a new sheet, paste all 200 rows of needed data there, and export the whole sheet as csv. Then clear or delete it and start again with the next batch. — Plutian, Dec 03 '19 at 09:51
You could try starting [here](https://stackoverflow.com/questions/37037934/excel-macro-to-export-worksheet-as-csv-file-without-leaving-my-current-excel-sh) to create the csv from a worksheet. — Plutian, Dec 03 '19 at 09:53

score 0 · Answer 1 · answered Dec 03 '19 at 10:46

As comments suggested, the code below will aggregate the data in a new worksheet, then save that as a CSV in the same directory as the original Workbook, I've also added a number to the filename to distinguish between the split files:

Sub SplitToCSV()
Dim CSheet As Worksheet: Set CSheet = Worksheets("Cleaned_Data")
Dim ws As Worksheet
Dim LastRow As Long, LastCol As Long, numOfFiles As Integer
Dim filePath As String, dataDate As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False


    LastRow = CSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = CSheet.Cells(1, Columns.Count).End(xlToLeft).Column

    dataDate = Format(Worksheets("Instructions").Cells(14, 2), "DD-MMM-YYYY")
    WName = Left(Application.ActiveWorkbook.Name, InStr(Application.ActiveWorkbook.Name, ".") - 1)

    numOfFiles = (LastRow - 1) / 200

    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Temp"
    'create a Temp Worksheet

    For i = 1 To numOfFiles

        filePath = Application.ActiveWorkbook.Path & "\" & WName & " " & dataDate & " - " & i
        'Append the filenumber to the end of the filename

        ws.Rows(1).Value = CSheet.Rows(1).Value
        'copy headers

        If i = 1 Then
            CSheet.Range(CSheet.Cells(1 + (200 * (i - 1)), 1), CSheet.Cells(i * 200, LastCol)).Copy ws.Range("A1")
        Else
            CSheet.Range(CSheet.Cells(1 + (200 * (i - 1)), 1), CSheet.Cells(i * 200, LastCol)).Copy ws.Range("A2")
        End If
        'transfer data to Temp worksheet

        ws.Copy
        ActiveWorkbook.SaveAs Filename:=filePath, FileFormat:=xlCSV, CreateBackup:=True
        ActiveWorkbook.Close
        'Save worksheet as CSV

    Next i

    ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

score 0 · Answer 2 · answered Dec 03 '19 at 10:56

You could try something along these lines, i have set a constant file count, you can use your original dividing code to sort that out :

Private Const cstChunkSize As Long = 200

Sub implementation()

Dim lngFileNum As Long
Dim wbExport As Excel.Workbook
Dim wsExport As Excel.Worksheet
Dim lngCols As Long
Dim rngChunk As Excel.Range

lngCols = 20

For lngFileNum = 1 To 10

    Set wbExport = Workbooks.Add
    Set wsExport = wbExport.Worksheets(1)

    Set rngChunk = GetChunk(ThisWorkbook.Worksheets("Sheet1").Range("a1"), _
                    lngCols, lngFileNum)

    wsExport.Range("a1").Resize(cstChunkSize, lngCols).Value = rngChunk.Value

    wsExport.SaveAs "C:\Databases\CSV\NEWEST2_EXPORT_" & lngFileNum & ".csv", xlCSV

    wbExport.Close False

Next lngFileNum

Set wbExport = Nothing
Set wsExport = Nothing
Set rngChunk = Nothing

End Sub
Function GetChunk(rngStartPoint As Excel.Range, _
                    lngColumns As Long, _
                    lngChunkNumber As Long, _
                    Optional lngChunkSize As Long = cstChunkSize) As Excel.Range

Dim r As Excel.Range

Set r = rngStartPoint.Offset((lngChunkSize * (lngChunkNumber - 1)))
Set r = r.Resize(lngChunkSize, lngColumns)

Set GetChunk = r

End Function

Copy data from existing sheet to new csv file

2 Answers2