Macro to cut one sheet into many

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
Hello
Trying to write a macro to cut up a sheet, but im not very good at visbasic. I've got a sheet full of rows of data, with a one blank row gap every so often. I want a macro that works its way down the rows and when it gets to an empty row (or the empty cell of an empty row) it cuts everything below to another sheet. Then i could run it again on that sheet and keep on doing that till all the data groups are on. Couldn't find anything like this on other posts.
Can anyone help?
Thanks
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Bruno

Active Member
Joined
Feb 17, 2002
Messages
491
This could be a start :
Code:
Sub CutSheetIntoManyPieces()
Dim SheetNr As Integer
Dim MyRange As Range
Set MyRange = Sheets(1).Range("A1:A" & Range("A65536").End(xlUp).Row)
SheetNr = 2

For Each c In MyRange
    If c = "" Then SheetNr = SheetNr + 1
    c.EntireRow.Copy _
        Worksheets(SheetNr).Range("A65536").End(xlUp).Offset(1, 0)
Next
End Sub
This codes leaves the original data on sheet1 intact.
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
Hi
Thanks mate but im getting a "subscript out of range" error when i run the script.
Any ideas?
 

Bruno

Active Member
Joined
Feb 17, 2002
Messages
491

ADVERTISEMENT

Are there enough sheets to put the data in ?
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
er was thinking that the macro might make a new sheet then copy the data over.
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
There is this macro

Sub BatchIt()
Const lBatch As Long = 50
Dim lRow As Long, lCol As Long, lNoShts As Long, lCnt As Long
Dim wsData As Worksheet, wsNew As Worksheet
Dim rngHeader As Range

Set wsData = ThisWorkbook.Worksheets("Sheet1")
'change the name of the sheet as required

Application.ScreenUpdating = False

With wsData

lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lRow = lRow - 1
lNoShts = Application.WorksheetFunction.RoundUp(lRow / lBatch, 0)
'establish last column, last row , number of sheets needed

Set rngHeader = .Range("A1:A" & lCol)
'the header row to copy

For lCnt = 1 To lNoShts

Set wsNew = ThisWorkbook.Worksheets.Add
wsNew.Name = "Batch" & lCnt
'add and name a sheet

rngHeader.Copy Destination:=wsNew.Range("A1")
lRow = 2 + ((lCnt - 1) * lBatch)
.Range(.Cells(lRow, 1), .Cells(lRow + lBatch - 1, lCol)).Copy _
Destination:=wsNew.Range("A2")
'copy the header and batch to the new sheet

Next lCnt

End With

Application.ScreenUpdating = True

End Sub
from one sheet it creates a new sheet and copies 50 rows to it, then does the same for the next 50 rows etc etc. I want something like this but instead of 50 rows it looks for empty rows or cells and copies the data based on where these empties are.

Thanks
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
er still need w wat of cutting up this sheet any help anyone? Last time i queue jump i promise
 

Forum statistics

Threads
1,147,510
Messages
5,741,574
Members
423,668
Latest member
Audorin

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