Splitting Data - Modifying Code

22strider

Active Member
Joined
Jun 11, 2007
Messages
302
Hello Friends

I created code for splitting data in one spreadsheet into multiple sheets in the same file. The code works; but I want to make it more generic. I had to hard code column reference 'G' while specifying Cut (or Copy) from range. I want to make it intuitive so that I can use this code for data that may have different number of columns.
I am relatively new to Excel VBA; so I created this code based on what I have learnt so far. Please let me know if there is another more efficient way of splitting the data.
Is it possible to save the new spreadsheets (that the code creates while splitting the data) as separate new files? That is my next step in the project. I didn't know how to do that so I stopped after data splitting.
The code follows this message.

Thanks
Rajesh

Sub TestCopyRecords()

Dim RowCount As Long
Dim i As Integer
Dim RowRange As Long
Dim SheetName As String

'Initializing the counter to be used for sheet names

i = 1

RowCount = Worksheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row

Do While RowCount > 999

'Inserting new worsheet
Sheets.Add After:=Sheets(Sheets.Count)

'Renaming worksheet to be Load1, Load2 etc.
SheetName = "Load" & i
ActiveSheet.Name = SheetName

'Copy and pasting title row to the newly created worksheet
Sheets("DataSheet").Range("A1:G1").Copy Sheets(SheetName).Range("A1")

'Moving last 999 records from the source sheet (DataSheet) to the _
newly created worksheet

'RowRange = RowCount - 999

Sheets("DataSheet").Range("A" & RowCount - 999, "G" & RowCount). _
Cut (Sheets(SheetName).Range("A2"))

'incrementing i for sheet names
i = i + 1
RowCount = Worksheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("DataSheet").Select
Loop

'Once the number of records is less than 999 moving rest of the _
records to a new sheet as well

Sheets.Add After:=Sheets(Sheets.Count)

SheetName = "Load" & i

ActiveSheet.Name = SheetName

'Updating variable RowCount for the resudual data to move
RowCount = Worksheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row
'Moving records to the new sheet
Sheets("DataSheet").Range("A1", "G" & RowCount). _
Cut (Sheets(SheetName).Range("A1"))

End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Watch MrExcel Video

Forum statistics

Threads
1,130,051
Messages
5,639,773
Members
417,112
Latest member
PachRedoc

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