Selecting sets of 21 Rows and saving as a csv

[Emmerly]

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]

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]

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]

@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]

Perfect! That makes my life so much easier

[mancubus]

@snb
you are right. i'll amend the code in my 'archived' workbook to suit yours.

@Emmerly
you are welcome.