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 ........


 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,363
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,363
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
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,063
Messages
5,509,072
Members
408,705
Latest member
denesh3560

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top