Split a large 2007 worksheet into smaller tabs of 65000 rows

[ushankar]

Hi

I have a sheet with 400000 rows and like to have macro break it into small tabs each with 65000 rows and copy the header in every tabs. can somebody help me please?

 

[SirJB7]

Hi, ushankar!

Go to VBA editor (Alt-F11), Insert, New Module, and copy/paste this:

-----

Option Explicit


Sub Splitty()

' constantes

Const ksWorksheetInput = "Input"

Const ksWorksheetOutput = "Output"

Const klWorksheetOutputRows = 5

' declaraciones

Dim iWorksheetOutput As Integer, sWorksheetOutput As String, sWorksheetOutputAnt As String

Dim lWorksheetInputRows As Long, lWorksheetInputRow As Long

' inicio

' input rows count

With Worksheets(ksWorksheetInput)

.Activate

.Range("A1").Select

Selection.End(xlDown).Select

lWorksheetInputRows = ActiveCell.Row

End With

lWorksheetInputRow = 1

' output counters

iWorksheetOutput = 0

sWorksheetOutputAnt = ksWorksheetInput

' proceso

Do While lWorksheetInputRow <= lWorksheetInputRows

' output

' new sheet

iWorksheetOutput = iWorksheetOutput + 1

sWorksheetOutput = ksWorksheetOutput + CStr(iWorksheetOutput)

On Error Resume Next

Worksheets(sWorksheetOutput).Activate

If Err.Number > 0 Then

On Error GoTo 0

' name

Worksheets.Add , Worksheets(sWorksheetOutputAnt)

ActiveSheet.Name = sWorksheetOutput

End If

ActiveSheet.Cells.ClearContents

' titles

With Worksheets(ksWorksheetInput)

.Activate

.Rows("1:1").Select

Selection.Copy

End With

Worksheets(sWorksheetOutput).Activate

ActiveSheet.Rows("1:1").Select

ActiveSheet.Paste

' read input

With Worksheets(ksWorksheetInput)

.Activate

.Rows(CStr(lWorksheetInputRow + 1) & ":" & CStr(lWorksheetInputRow + klWorksheetOutputRows)).Select

End With

Selection.Copy

' copy output

Worksheets(sWorksheetOutput).Activate

With ActiveSheet

.Range("A2").Select

.Paste

.Range("A2").Select

End With

' next input

sWorksheetOutputAnt = sWorksheetOutput

lWorksheetInputRow = lWorksheetInputRow + klWorksheetOutputRows

Loop

' fin

Application.CutCopyMode = False

Worksheets(ksWorksheetInput).Activate

Range("A2").Select

Beep

End Sub

-----

Then change the values for ksWorksheetInput (name for input worksheet), ksWorksheetOutput (name for output worksheets in format "XXXXXn", where n=1,2,...) and klWorksheetOutputRows (in your case 65000).

Run macro Splitty, and that's all.

Regards!

 

[ushankar]

Hi SirJB7, thank for your help. I will try.