Copy parts of a data range into a new spreadsheet
 

A have a spreadsheet with about 1000 lines of data. I want to copy the first
50 rows into a new spreadsheet. The data starts in A5. The last column of
data is in K.

Here's the problem. I need to first insert the spreadsheet to the right of
the data worksheet. Then I want to copy the first 50 rows.

I also want it to continuing inserting worksheets and copying data until the
original spreadsheet no longer has data to copy., e.g. rows a5:a54,a55:a104,
etc.

Thanks

Copy parts of a data range into a new spreadsheet
 

I think this code will do the trick for you. To get it into your workbook,
open the workbook then press [Alt]+[F11] to open the VB Editor. In the VBE
choose Insert | Module and then copy and paste the code into the module
presented to you. Close the VB Editor. Then choose the sheet with your 1000
or so rows of data and use Tools | Macro | Macros to identify and run the
macro.

One thing to watch for, the code uses column A to determine how far down the
worksheet your data goes, so there must be an entry in column A in the last
row used for it to work properly. Otherwise you'll need to change the code
to test a different column.

Sub SplitData()
'you must have the sheet with the data on it
'selected when you begin running this macro
'Assumes all cells in Column A for any data row
'are filled
Const firstCol = "A"
Const lastCol = "K"
Const firstDataRow = 5
Const rowsPerSheet = 50

Dim lastRow As Long
Dim firstCopyRow As Long
Dim lastCopyRow As Long
Dim sourceWS As Worksheet
Dim sourceRange As Range
Dim destWS As Worksheet
Dim destRange As Range

'work with the data sheet
Set sourceWS = ActiveSheet
'determine last row with data
lastRow = sourceWS.Range(firstCol & _
Rows.Count).End(xlUp).Row
'test if any work to be done
If lastRow < firstDataRow Then
Exit Sub ' nothing to copy
End If
'initialize rows to be copied pointers
firstCopyRow = firstDataRow
lastCopyRow = firstCopyRow + rowsPerSheet
Do While firstCopyRow < lastRow
'************************
'add a new worksheet
'behind the data sheet
Worksheets.Add after:=sourceWS
'if you want new sheets to actually be
'at the far right of all other sheets, then
'use this instead:
'Worksheets.Add after:=Worksheet(Worksheets.Count)
'************************
'new sheet becomes the active sheet
Set destWS = ActiveSheet
'set up the destination range reference
Set destRange = destWS.Range("A1:K50")
'set up the source range reference
Set sourceRange = sourceWS.Range(firstCol & _
firstCopyRow & ":" & lastCol & lastCopyRow)
'do the copy
destRange.Value = sourceRange.Value
'adjust the pointers
firstCopyRow = lastCopyRow + 1
lastCopyRow = firstCopyRow + rowsPerSheet
Loop ' end of Do While loop
End Sub


"forest8" wrote:

A have a spreadsheet with about 1000 lines of data. I want to copy the first
50 rows into a new spreadsheet. The data starts in A5. The last column of
data is in K.

Here's the problem. I need to first insert the spreadsheet to the right of
the data worksheet. Then I want to copy the first 50 rows.

I also want it to continuing inserting worksheets and copying data until the
original spreadsheet no longer has data to copy., e.g. rows a5:a54,a55:a104,
etc.

Thanks

Copy parts of a data range into a new spreadsheet
 

"forest8" wrote:

A have a spreadsheet with about 1000 lines of data. I want to copy the first
50 rows into a new spreadsheet. The data starts in A5. The last column of
data is in K.

Here's the problem. I need to first insert the spreadsheet to the right of
the data worksheet. Then I want to copy the first 50 rows.

I also want it to continuing inserting worksheets and copying data until the
original spreadsheet no longer has data to copy., e.g. rows a5:a54,a55:a104,
etc.

Thanks

Copy parts of a data range into a new spreadsheet
 

Hi

Thanks for the help. Just one question. This works great as is. But when
I tried to use the code to add the new worksheets after, it didn't work.

J

"JLatham" wrote:

I think this code will do the trick for you. To get it into your workbook,
open the workbook then press [Alt]+[F11] to open the VB Editor. In the VBE
choose Insert | Module and then copy and paste the code into the module
presented to you. Close the VB Editor. Then choose the sheet with your 1000
or so rows of data and use Tools | Macro | Macros to identify and run the
macro.

One thing to watch for, the code uses column A to determine how far down the
worksheet your data goes, so there must be an entry in column A in the last
row used for it to work properly. Otherwise you'll need to change the code
to test a different column.

Sub SplitData()
'you must have the sheet with the data on it
'selected when you begin running this macro
'Assumes all cells in Column A for any data row
'are filled
Const firstCol = "A"
Const lastCol = "K"
Const firstDataRow = 5
Const rowsPerSheet = 50

Dim lastRow As Long
Dim firstCopyRow As Long
Dim lastCopyRow As Long
Dim sourceWS As Worksheet
Dim sourceRange As Range
Dim destWS As Worksheet
Dim destRange As Range

'work with the data sheet
Set sourceWS = ActiveSheet
'determine last row with data
lastRow = sourceWS.Range(firstCol & _
Rows.Count).End(xlUp).Row
'test if any work to be done
If lastRow < firstDataRow Then
Exit Sub ' nothing to copy
End If
'initialize rows to be copied pointers
firstCopyRow = firstDataRow
lastCopyRow = firstCopyRow + rowsPerSheet
Do While firstCopyRow < lastRow
'************************
'add a new worksheet
'behind the data sheet
Worksheets.Add after:=sourceWS
'if you want new sheets to actually be
'at the far right of all other sheets, then
'use this instead:
'Worksheets.Add after:=Worksheet(Worksheets.Count)
'************************
'new sheet becomes the active sheet
Set destWS = ActiveSheet
'set up the destination range reference
Set destRange = destWS.Range("A1:K50")
'set up the source range reference
Set sourceRange = sourceWS.Range(firstCol & _
firstCopyRow & ":" & lastCol & lastCopyRow)
'do the copy
destRange.Value = sourceRange.Value
'adjust the pointers
firstCopyRow = lastCopyRow + 1
lastCopyRow = firstCopyRow + rowsPerSheet
Loop ' end of Do While loop
End Sub


"forest8" wrote:

A have a spreadsheet with about 1000 lines of data. I want to copy the first
50 rows into a new spreadsheet. The data starts in A5. The last column of
data is in K.

Here's the problem. I need to first insert the spreadsheet to the right of
the data worksheet. Then I want to copy the first 50 rows.

I also want it to continuing inserting worksheets and copying data until the
original spreadsheet no longer has data to copy., e.g. rows a5:a54,a55:a104,
etc.

Thanks

Copy parts of a data range into a new spreadsheet
 

you wrote: "Thanks for the help. Just one question. This works great as is.
But when I tried to use the code to add the new worksheets after, it didn't
work."

I'm not sure what you meant by "add the new worksheets after" - after what?

As originally written it places each new sheet right behind the sheet that
is selected at the time the code is run.

If you'd like to add all sheets to the end of the workbook, then replace the
line that reads
Worksheets.Add after:=sourceWS
with
Worksheets.Add after:=Worksheets(Worksheets.Count)

Note that I see I made a typo in the initial code in the example, leaving
out the "s" needed right in front of the ( in the statement. My apologies
for the typo.



"forest8" wrote:



"forest8" wrote:

A have a spreadsheet with about 1000 lines of data. I want to copy the first
50 rows into a new spreadsheet. The data starts in A5. The last column of
data is in K.

Here's the problem. I need to first insert the spreadsheet to the right of
the data worksheet. Then I want to copy the first 50 rows.

I also want it to continuing inserting worksheets and copying data until the
original spreadsheet no longer has data to copy., e.g. rows a5:a54,a55:a104,
etc.

Thanks