asked on

VBA: export, split csv file every x lines

Hello experts,

I used the following procedure in order to export and split data into csv files based on specific column reported in the procedure:

Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

iCol = 2                                '### Define your criteria column
strOutputFolder = "CSV output"          '### Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet       '### Don't edit below this line
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
  If strItem <> "" Then
    ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
    Workbooks.Add
    ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]
    strFilename = strOutputFolder & "\" & strItem
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close savechanges:=False
  End If
Next
ws.ShowAllData

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

Open in new window

I would like to use the procedure as a reference in order to cover the following need:

1-Instead of export and split data into csv based on iCol I would like to define a numeric criteria number. Example: If numeric criteria number is equal to 3 this means that csv files should be generated dynamically every tree lines. This means that the header line should be keep for the various files and the first file should contains header + line 2 to line 5.
File 2 should contains header + line 6 to 9 and so on.
2-Export should be done till the last used range.
3-The procedure should contains the row number related to the header. Example if HeaderRow = 3 this means that the procedure should take into account the Row 3 as a Header and begins the split as of line 4
4-Export files should have an static name reported in the procedure following with the current date “Export” & “YYYY_MM_DD_MM_SS” (current date format).

I attached a dummy file.

If you have questions, don’t hesitate to contact me.
Export-csv-every-x-lines.xlsm

Rgonzo1971

Hi,

pls try

Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

iHeaderLn = 1
iLineCount = 3
strOutputFolder = "Output CSV"          '### Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet       '### Don't edit below this line

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder

For Idx = iHeaderLn + 1 To WorksheetFunction.MRound(Range("A" & Rows.Count).End(xlUp).Row, iLineCount) + iHeaderLn Step iLineCount
    Workbooks.Add
    ws.Range("A" & iHeaderLn).EntireRow.Copy Destination:=[A1]
    ws.Range("A" & Idx).Resize(iLineCount).EntireRow.Copy Destination:=[A2]
    strFilename = strOutputFolder & "\" & "Export" & Format(Now(), "YYYY_MM_DD_HH_NN_SS")
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close savechanges:=False
Next

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

Open in new window

Regards

Rgonzo1971

Corrected code

SuSub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

iHeaderLn = 8
iLineCount = 3
strOutputFolder = "Output CSV"          '### Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet       '### Don't edit below this line

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
lLastRow = Split(ActiveSheet.UsedRange.Address, "$")(4)
For Idx = iHeaderLn + 1 To (WorksheetFunction.RoundDown((lLastRow) / iLineCount, 0) * iLineCount) + ((iHeaderLn) Mod iLineCount) Step iLineCount

    Workbooks.Add
    ws.Range("A" & iHeaderLn).EntireRow.Copy Destination:=[A1]
    ws.Range("A" & Idx).Resize(iLineCount).EntireRow.Copy Destination:=[A2]
    strFilename = strOutputFolder & "\" & "Export" & Format(Now(), "YYYY_MM_DD_HH_NN_SS")
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close savechanges:=False
Next

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

Open in new window

Luis Diaz

ASKER

Thank you very much for this proposal.

I will test it as soon as I can.

Luis Diaz

ASKER

Hello,

I tested the revised code but I have some little problem;

I used the reference Workbook:

I reported:
iHeaderLn = 2
iLineCount = 3

However I just have one csv file with the following information:

And normally I should have two files:
File1:

File2:

I attached the dummy file with your last proposal.

Thank you very much for your help.

Rgonzo1971

then try

Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ChDir ("m:")
iHeaderLn = 2
iLineCount = 3
strOutputFolder = "Output CSV"          '### Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet       '### Don't edit below this line

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
lLastRow = Split(ActiveSheet.UsedRange.Address, "$")(4)
For Idx = iHeaderLn + 1 To (WorksheetFunction.RoundDown((lLastRow) / iLineCount, 0) * iLineCount) + ((iHeaderLn) Mod iLineCount) Step iLineCount

    Workbooks.Add
    ws.Range("A" & iHeaderLn).EntireRow.Copy Destination:=[A1]
    ws.Range("A" & Idx).Resize(iLineCount).EntireRow.Copy Destination:=[A2]
    strFilename = strOutputFolder & "\" & "Export" & Format(Now(), "YYYY_MM_DD_HH_NN_SS")
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close savechanges:=False
Next

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

Open in new window

Luis Diaz

ASKER

I tested the las version however I have just one file instead of two files:

Still missing lines 1 to 4 for a new file. Do you know why?

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Thank you very much for this proposal.

I tested the last version but I am still having one file instead of two files.

I attached my dummy file. I just change the output folder.

Thank you again for your help.
Export-csv-every-x-lines.xlsm

Rgonzo1971

I get 2 files

Luis Diaz

ASKER

Mmm, strange and you set up the argument like this?

iHeaderLn = 4
iLineCount = 3

Or

iHeaderLn = 2
iLineCount = 3

Rgonzo1971

I've run the macro in your file
iHeaderLn = 2
iLineCount = 3

Luis Diaz

ASKER

I tested again from another computer and it works!!!!!!!
Thank you again for your help!!!!!!!!

Luis Diaz

ASKER

Hello Rgonzo,

Sorry to disturb you again I run again the macro in an Excel version 2007 and I just got one file with the last line related.
However this was not the case when I run it in another computer equiped by Excel version 2010.
Do you know what should I modify to be able to properly run the macro and get the expected files in Excel version 2007?

Thank you again for your help.