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
On Nov 5, 11:44 am, Freddy <Fre...@discussions.microsoft.com> wrote:
> 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
|