Macro to: Copy rows of data from one workbook to another

[arosier]

I am hoping someone could help me with this, or at least direct me to where I would find help.

I have a workbook with about 500,000 rows of data, I need the data divided up into workbooks each containing 300 rows of the data.

So I have one workbook with 500,000 rows, I need 1666 workbooks with 300 rows of data. I also would like to save them all in the same folder with a naming convention that counts up, i.e. "data1" "data2" data3".

I am not sure how this is possible but I am picturing some sort of macro that runs through the existing workbook,
1) opening a new workbook cutting the first 300 rows from the original document,
2) and pasting them in the new workbook,
3) saving as "data1".
Continuing on to the next 300 hundred:
4) opening a new workbook,
5) cutting the next 300 data rows form the original workbook,
6) pasting in the new one and
7) saving as "data2", and looping...

I am willing to pay for any assistance. Thank you for the assistance!

 

[oldbrewer]

you are on the right track - switch on record macro - create a new workbook, go back to big file, cut first 300 rows, go to the new workbook and paste them in, go back to big file and end macro - look at the coding, and set up a loop from 1 to 1666 to repeat this operation - loop will be 1 to 1666 and within that a loop from 1 to 500000 step 300 so second loop goes 1 to 300, then 301 to 600 etc etc

 

[arosier]

Thanks oldbrewer. The only problem I had with that was editing the naming convention. I ended up hiring someone to write the macro. I thought I would share it here in case someone else can use it.

This will open a new workbook copy 300 rows from the original workbook, save the new workbook and continue to loop for however many workbooks you need.

Sub Naveen_Macro()
'
' Macro1 Macro
'
Application.DisplayAlerts = False
Application.DisplayStatusBar = True
Application.ScreenUpdating = False






v_lrow = Sheets("Sheet1").UsedRange.Rows.Count
MyPath = ThisWorkbook.Path
v_start = 1
v_end = 300
For v_count = 1 To 1666


Application.StatusBar = "Now at : " & CStr(v_count)


On Error Resume Next
Sheets("Temp").Delete
On Error GoTo 0


Sheets.Add.Name = "Temp"




Sheets("Sheet1").Select

Rows(CStr(v_start) & ":" & CStr(v_end)).Select
Selection.Copy
Sheets("Temp").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "FirstName"
Range("C1").Select
ActiveCell.FormulaR1C1 = "FullName"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Phone"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Email"
Range("A1:K1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
lrintemp = Sheets("Temp").UsedRange.Rows.Count
For lr = 2 To lrintemp
Range("A2").Select
Sheets("Temp").Cells(lr, 1).Value = "Name " & CStr(lr - 1)
Sheets("Temp").Cells(lr, 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next lr

v_oldname = "Temp"
v_newname = "File_Rows_" & CStr(v_start) & "_to_" & CStr(v_end)
Sheets(v_oldname).Name = v_newname
Sheets(v_newname).Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\File_Rows_" & CStr(v_start) & "_to_" & CStr(v_end) & ".xlsx"
ActiveWorkbook.Close savechanges:=False


x = v_end
v_start = v_end + 1
v_end = x + 300
Sheets(v_newname).Name = v_oldname
Next v_count
MsgBox "Completed !"
End Sub