PDA

View Full Version : [SOLVED] Selecting sets of 21 Rows and saving as a csv



Emmerly
10-29-2015, 03:55 AM
Hello,

I have one of those projects that I thought would be really easy and turns out that it would be a lot harder than I thought!

I have a spreadsheet which has about 1000 rows in and I need to copy 21 rows at a time and then save those 21 rows it as a separate csv file. I'm struggling to find the best way to copy the 21 rows and then copy the next 21 rows, if you could point me in the right direction that would be really helpful!

Thanks :)

snb
10-29-2015, 04:10 AM
Sub M_snb()
sn=thisworkbook.sheet1.cells(1).currentregion
sp=evaluate("transpose(row(1:" & ubound(sn,2) & "))")

with workbooks.add
for j=1 to ubound(sn) step 21
.sheet1.cells(1).resize(21,ubound(sn,2))= application.index(sn, evaluate("row(" j & ":" & j+21 & ")"),sp)
.saveas "G:\OF\file " & j & ".csv",21
next
.close 0
end with
End sub

mancubus
10-29-2015, 04:22 AM
EDIT: i sometimes forget refreshing the page to see if any solution is posted. :)

_______________________________________________________________

hi.
try this.

saves csv files in the same directory...


Sub vbax_54140_Save_Every_N_Rows_As_Separate_CSV_Files()

Dim i As Long, EveryNRows As Long

EveryNRows = 21

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With

With ActiveSheet.Cells(1).CurrentRegion
For i = 1 To .Rows.Count Step EveryNRows
.Cells(i, 1).Resize(EveryNRows, .Columns.Count).Copy
Workbooks.Add(xlWBATWorksheet).Sheets(1).Cells(1).PasteSpecial
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Rows_" & i & "_" & (i + EveryNRows - 1) & ".csv", xlCSV
.Close False
End With
Next i
End With


With Application
.EnableEvents = True
End With

End Sub

snb
10-29-2015, 04:42 AM
@mancubus

I think 1 new workbook should be sufficient..(also in your method)


Sub M_snb()
With Workbooks.Add
For j = 1 To ThisWorkbook.Sheets(1).Cells(1).CurrentRegion.Rows.Count Step 21
Intersect(ThisWorkbook.Sheets(1).Cells(1).CurrentRegion, Rows(j).Resize(21)).Copy .Sheets(1).Cells(1)
.SaveAs "G:\OF\file_" & j & ".csv", 23
Next
.Close 0
End With
End Sub

and this might be much faster:


Sub M_snb()
sn = ThisWorkbook.Sheets(1).Cells(1).CurrentRegion

For j = 1 To UBound(sn) Step 21
c00 = ""
For jj = 1 To 21
c00 = c00 & vbLf & Join(Application.Index(sn, j), "_")
Next
CreateObject("scripting.filesystemobject").createtextfile("G:\OF\file_" & j & ".csv").write Mid(c00, 2)
Next
End Sub

Emmerly
10-29-2015, 05:05 AM
Perfect! That makes my life so much easier :)

mancubus
10-29-2015, 05:56 AM
@snb
you are right. i'll amend the code in my 'archived' workbook to suit yours.

@Emmerly
you are welcome.