copy 8000 rows and paste in new workbook

negi

Board Regular
Joined
Apr 16, 2009
Messages
82
hi,
i am using excel 2007 and i have more then 200000 records in one sheet.now i want to copy 8000 records and paste in excel 2003 format and save it part 1.then next 8000 re copy and repeat same.
Please help ........


 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,811
Try this, but first edit the code to test it on a small number of rows, by changing the lastRow and numRows lines, say lastRow = 100, numRows = 10. You will need to change the folder path in the SaveAs.
Code:
Sub Copy_8000()
    Dim r As Long, lastRow As Long, numRows As Long
    Dim part As Integer
    
    part = 0
    lastRow = 200000
    numRows = 8000
    For r = 1 To lastRow Step numRows
        part = part + 1
        Rows(r & ":" & r + numRows - 1).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveWorkbook.SaveAs Filename:="C:\temp\excel\Part_" & part & ".xls", FileFormat:=xlExcel8
        ActiveWorkbook.Close savechanges:=False
    Next
    
End Sub
 
Last edited:

negi

Board Regular
Joined
Apr 16, 2009
Messages
82
Hi,
john Thanks.
But problem in Workbooks.Add
please help
 

negi

Board Regular
Joined
Apr 16, 2009
Messages
82
dear jhon one more help please
i want copy first heading in every workbook
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,811
But problem in Workbooks.Add
What is the exact error? The code works for me in Excel 2003 and 2007. Help yourself by recording a macro to create a new workbook to show the full syntax of Workbooks.Add and using that in my code.

Here is a new version which copies the column headings to each new workbook:
Code:
Sub Copy_8000B()

    Dim r As Long, lastRow As Long, numRows As Long
    Dim part As Integer
    Dim thisSheet As Worksheet
    
    lastRow = 200000
    numRows = 8000
    part = 0
    Set thisSheet = ActiveSheet
    
    For r = 2 To lastRow Step numRows
        part = part + 1
        Workbooks.Add
        thisSheet.Rows(1).Copy Rows(1)
        thisSheet.Rows(r & ":" & r + numRows - 1).Copy Rows(2)
        
        ActiveWorkbook.SaveAs Filename:="C:\temp\excel\Part_" & part & ".xls", FileFormat:=xlExcel8
        ActiveWorkbook.Close savechanges:=False
    Next
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,132,878
Messages
5,655,766
Members
418,236
Latest member
jess5789

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top