For Every 1500 Rows Copy To New Sheet & Save

[DataBlake]

I'm struggling with the logic behind this statement
I assign an entire sheet to an array
then i want
for every 1500 rows
write those values to new sheets
include header/insert header
save as csv (comma delimited) and close sheet
next 1500 rows

This is to happen until there are no rows left and the last sheet will be under 1500

My attempt:

Dim ary1 as Variant
Dim ws as WorkSheet
Dim i as Long
Dim x as Long

'establish sheet, array, and last column of activesheet
Set ws = ActiveSheet
  ary1 = ws.Range("A1").CurrentRegion.Value2
    lastCol = openWB.Sheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Column

'loop through array by rows
for i = 1500 to UBound(ary1)

'for every 1500 rows of the array what do?
Sheets.Add (After:= ws)
'ActiveSheet.Range("A1").Resize(???(ary1), lastCol).Value = ary1



Dim fold As String: fold = "C:\Users\user\Desktop\"
Dim fName  As String: fName = "newSHEET"

  With ActiveWorkbook
    .SaveAs fold & fName & Format(Date, "MM-DD-YYYY") & ".csv", FileFormat:=xlCSV
    .Close False
  End With
  
ActiveSheet.Delete

My brain is not comprehending how to loop through the array as 1500
any help would be appreciated

 

[DataBlake]

I tested the code I posted on a workbook with 5 sheets and it ran fine for me albeit with far fewer populated rows on each sheet than you have on your sheets. I don't see any difference between the array of arrays and writing one array at a time to the condensed sheet, but you can certainly do it one-at-a-time by looping through the sheets.

perhaps my other codes are interfering then?
the first time i ran it i had 5 sheets, but that included the sheets im trying to skip. after realizing this and letting the sheet go unresponsive i few times i managed to pause the macro
the second time i ran it i did not pause the macro and it made my computer commit seppuku

i have these two sheet/workbook codes

in sheet1 ("Program Start")

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$A$2" Then
   pStart.Show
   Sheets("Program Start").Select
End If

If Target.Address = "$A$3" Then
   Application.Run "PERSONAL.XLSB!dictionaryeBay"
   Sheets("Program Start").Select
End If

If Target.Address = "$A$4" Then
   exports.Show
   Sheets("Program Start").Select
End If
End Sub

in "ThisWorkBook" i have

Sub Workbook_Open()

'Update Finish Color Dictionary
Application.Run "PERSONAL.XLSB!dictionarySHORT"
Application.Run "Personal.xlsb!dictionaryFINISH"

'Update Image Dictionary
Application.Run "PERSONAL.XLSB!dictionaryIMG"

'Update Quantity Dictionary
Application.Run "PERSONAL.XLSB!dictionaryQTY"

End Sub

i did not attempt skipping the first sheet called "Program Start"
i just ran your code as is.

 

[JoeMo]

perhaps my other codes are interfering then?
the first time i ran it i had 5 sheets, but that included the sheets im trying to skip. after realizing this and letting the sheet go unresponsive i few times i managed to pause the macro
the second time i ran it i did not pause the macro and it made my computer commit seppuku

i have these two sheet/workbook codes

in sheet1 ("Program Start")

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$A$2" Then
   pStart.Show
   Sheets("Program Start").Select
End If

If Target.Address = "$A$3" Then
   Application.Run "PERSONAL.XLSB!dictionaryeBay"
   Sheets("Program Start").Select
End If

If Target.Address = "$A$4" Then
   exports.Show
   Sheets("Program Start").Select
End If
End Sub

in "ThisWorkBook" i have

Sub Workbook_Open()

'Update Finish Color Dictionary
Application.Run "PERSONAL.XLSB!dictionarySHORT"
Application.Run "Personal.xlsb!dictionaryFINISH"

'Update Image Dictionary
Application.Run "PERSONAL.XLSB!dictionaryIMG"

'Update Quantity Dictionary
Application.Run "PERSONAL.XLSB!dictionaryQTY"

End Sub

i did not attempt skipping the first sheet called "Program Start"
i just ran your code as is.

I found an error in the code I posted in post #18 that might possibly be the culprit with your more extensive data. Here's a revision you can try.

Sub CondenseSheetsData()
Dim MyArrays As Variant
Dim i As Long
Dim numSHEETS As Long
Dim NxRw As Long
Dim V As Variant
numSHEETS = 5    '(Worksheets("Description Helper").Index - 1)
ReDim MyArrays(1 To numSHEETS)
For i = 1 To UBound(MyArrays)
    MyArrays(i) = Sheets(i).Range("A1").CurrentRegion.Value2  'ary & i is the ith element in MyArrays
Next i
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CondensedSheets").Delete
On Error GoTo 0
Worksheets.Add after:=Sheets(numSHEETS)
ActiveSheet.Name = "CondensedSheets"
NxRw = 1
For i = 1 To UBound(MyArrays)
    V = MyArrays(i)
    Range(Cells(NxRw, 1), Cells(NxRw + UBound(V, 1) - 1, UBound(V, 2))) = V
    NxRw = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Erase V
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[DataBlake]

I found an error in the code I posted in post #18 that might possibly be the culprit with your more extensive data. Here's a revision you can try.

now thats spot on and took all of 3 seconds
the only thing i'm missing is the ability to select which sheets to target for this
i usually grab my sheets like

Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1

which is where i want the sheets condensed because they will always be between these two sheets
also +1 for the error handling if condensedsheets already existed

so i'm thinking

Dim MyArrays As Variant
Dim i As Long
Dim x As Long
Dim numSHEETS As Long
Dim NxRw As Long
Dim V As Variant
numSHEETS = Worksheets.Count '????
ReDim MyArrays(1 To numSHEETS)

x = 1

For i = Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
    
    MyArrays(x) = Sheets(i).Range("A1").CurrentRegion.Value2  'ary & i is the ith element in MyArrays
             x = x + 1
Next i

but how do i dim the proper numbers of worksheets to create these arrays? or is it fine if the number of arrays is larger than what we are assigning values to?

 

[JoeMo]

Assuming you have the sheets you want to place in an array between the "bookend" sheets "program Start" and "Description Helper", and depending on whether "CondensedSheets" exists outside the bookends, this will put the correct sheets, regardless of their number into the arrays within MyArray. "CondensedSheets", if already in place prior to running the macro, will be deleted and a fresh CondensedSheets will be created by the macro. See the comment in red on the code below, in case there are other sheets that you don't want in the array.

Sub CondenseSheetsData()
Dim MyArrays As Variant
Dim i As Long
Dim x As Long
Dim numSHEETS As Long
Dim NxRw As Long
Dim V As Variant
If SheetExists("CondensedSheets") Then
    numSHEETS = Sheets.Count - 3   '-3 is for shts that don't go into array:CondensedSheets and the 2 Bookends
Else
    numSHEETS = Sheets.Count - 2
End If
ReDim MyArrays(1 To numSHEETS)
x = 1
For i = Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
    MyArrays(x) = Sheets(i).Range("A1").CurrentRegion.Value2
    x = x + 1
Next i
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CondensedSheets").Delete
On Error GoTo 0
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "CondensedSheets"
NxRw = 1
For i = 1 To UBound(MyArrays)
    V = MyArrays(i)
    Range(Cells(NxRw, 1), Cells(NxRw + UBound(V, 1) - 1, UBound(V, 2))) = V
    NxRw = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Erase V
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function SheetExists(shName As String) As Boolean
SheetExists = False
For Each sh In ActiveWorkbook.Sheets
    If sh.Name = shName Then
        SheetExists = True
        Exit For
    End If
 Next sh
End Function

Be sure to copy ALL the code, including the Function at the bottom, from your browser, and paste it to the VB window.

 

[DataBlake]

Assuming you have the sheets you want to place in an array between the "bookend" sheets "program Start" and "Description Helper", and depending on whether "CondensedSheets" exists outside the bookends, this will put the correct sheets,

this is EXACTLY what i was looking for
thank you so much

 

[JoeMo]

this is EXACTLY what i was looking for
thank you so much

You are welcome - thanks for the reply.