Macro to cut one sheet into many

[steallan]

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

 

[Bruno_x]

This could be a start :

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]

Hi
Thanks mate but im getting a "subscript out of range" error when i run the script.
Any ideas?

 

[steallan]

er only posting to get my thread back to the top, sorry

HELP ME!

 

[Bruno_x]

Are there enough sheets to put the data in ?

 

[steallan]

er was thinking that the macro might make a new sheet then copy the data over.

 

[steallan]

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]

er still need w wat of cutting up this sheet any help anyone? Last time i queue jump i promise