Breakdown Excel 2007 worksheet to 65,000 worksheets for Excel 2003

[Guest]

I am continually being asked to send spreadsheets to people who are still
using Excel 97-2003 and therefore still limited to 65,000 rows.

This means, in the past, I have alwasy had to cut and paste manually.

I was wondering if someone may have an idea on speeding this process up. Is
there any code around that can split a worksheet up into smaller 65,000 row
worksheets.

Thanks in advance

 

[Guest]

How about a 2-step solution?

I have an Excel 2003 workbook with code already written that is intended to
permit a person to read in a CSV file that has more than 64K rows of data and
spread it across however many sheets are required to hold it all. Right now
it is set to limit rows per page based on the version of Excel you're
running, but for your purpose we'd need to make a very small change to fix
the limit to 64K.

Then your process would be to save from your 2007 workbook to a CSV file,
open the importing book and use it to read that data back into it at 64K/page
max.

Whatcha think?

 

[ilia]

This takes the ActiveSheet as source, creates a new workbook, and
breaks up ActiveSheet into 65,000 x 250 blocks. Each sheet in the new
workbook will be named by the address range it's representing.

Public Sub SplitSheet()
Dim wshSource As Excel.Worksheet
Dim wkbDest As Excel.Workbook
Dim wshDest As Excel.Worksheet
Dim iRow As Long, iCol As Long
Dim maxRow As Long, maxCol As Long
Dim startCell As Excel.Range
Dim endCell As Excel.Range
Dim blockRange As Excel.Range
Dim calcs As XlCalculation

Application.ScreenUpdating = False
calcs = Application.Calculation
Application.Calculation = xlCalculationManual

Set wshSource = Application.ActiveSheet
Set wkbDest = Application.Workbooks.Add

maxRow = wshSource.UsedRange.Rows.Count
maxCol = wshSource.UsedRange.Columns.Count

For iRow = 1 To maxRow Step 65000
For iCol = 1 To maxCol Step 250
Set startCell = wshSource.Cells(iRow, iCol)
Set endCell = wshSource.Cells( _
Application.WorksheetFunction.Min(maxRow, iRow + 64999), _
Application.WorksheetFunction.Min(maxCol, iCol + 249))
Set blockRange = wshSource.Range(startCell, endCell)
Set wshDest = wkbDest.Worksheets.Add
wshDest.Name = Replace(startCell.Address, "$", "") & " - " & _
Replace(endCell.Address, "$", "")
blockRange.Copy wshDest.Range("A1")
DoEvents
Next iCol
Next iRow

Application.ScreenUpdating = True
Application.Calculation = calcs
End Sub