Copying a differing range of rows to a new worksheet
 

I have a worksheet called "RawData" which has a continuous list of invoices,
I need to separate off the first invoice from the rest of the invoices into
a new worksheet and call it "sheet1". The number of rows from cell A1 at the
top left corner varies and is never constant from invoice to invoice however
the last row of the invoice I need to move always includes the text string
"NET PAYABLE TO". So I need to copy all rows from "A1" to the row that has
the text to a new worksheet called "sheet1", I then need to delete those
rows only from the original "RawData" worksheet, leaving the remaining
invoices in "RawData" intact. If it is helpful to you, the first row on
every invoice has the text string "TAX INVOICE"

Can this routine then be continued on all the other invoices in "RawData",
copying them to new worksheets in the same workbook "sheet2","sheet3" etc
until there is no data left in RawData, bearing in mind that there may be 10
invoices or 100 invoices in the "RawData" sheet.

I hope I explained this OK, I am only just dipping my toe in the water in
Excel programming and I am discovering that Excel can be amazingly
powerful....in the right hands, I think I am still wearing my kid gloves!!

Thanks for any assistance offered, I have spent hours looking at different
code examples on the net and attempting to make them work for me but to no
avail ;o(

Regards Andy
Cairns, Australia

Copying a differing range of rows to a new worksheet
 

There are some details I don't know, like the existence of blank rows
between invoices, but try this:

Public Function SeparateInvoices()
Dim shtRaw As Worksheet, shtInv As Worksheet
Dim lRow As Long, lCount As Long, lInitialRows As Long
Dim iSheet As Integer
Set shtRaw = Sheets("RawData")
lInitialRows = shtRaw.UsedRange.Rows.Count
iSheet = 1
Do While lCount < lInitialRows
lRow = 1
Do While Not InStr(1, shtRaw.Cells(lRow, 1).Value, "net
payable to", vbTextCompare) < 0
lRow = lRow + 1
Loop
If lRow 1 Then
Set shtInv = Sheets.Add
shtInv.Name = "Sheet" & iSheet
shtRaw.Range(shtRaw.Cells(1, 1).EntireRow, shtRaw.Cells
(lRow, 1).EntireRow).Copy shtInv.Range("A1")
shtRaw.Range(shtRaw.Cells(1, 1).EntireRow, shtRaw.Cells
(lRow, 1).EntireRow).Delete xlUp
End If
iSheet = iSheet + 1
lCount = lCount + lRow
Loop
Set shtInv = Nothing
Set shtRaw = Nothing
End Function

Copying a differing range of rows to a new worksheet
 

Hey, thanks Jason, I will give this a try when I get a moment, thanks for
your assistance.

Regards
Andy

"jasontferrell" wrote in message
...
There are some details I don't know, like the existence of blank rows
between invoices, but try this:

Public Function SeparateInvoices()
Dim shtRaw As Worksheet, shtInv As Worksheet
Dim lRow As Long, lCount As Long, lInitialRows As Long
Dim iSheet As Integer
Set shtRaw = Sheets("RawData")
lInitialRows = shtRaw.UsedRange.Rows.Count
iSheet = 1
Do While lCount < lInitialRows
lRow = 1
Do While Not InStr(1, shtRaw.Cells(lRow, 1).Value, "net
payable to", vbTextCompare) < 0
lRow = lRow + 1
Loop
If lRow 1 Then
Set shtInv = Sheets.Add
shtInv.Name = "Sheet" & iSheet
shtRaw.Range(shtRaw.Cells(1, 1).EntireRow, shtRaw.Cells
(lRow, 1).EntireRow).Copy shtInv.Range("A1")
shtRaw.Range(shtRaw.Cells(1, 1).EntireRow, shtRaw.Cells
(lRow, 1).EntireRow).Delete xlUp
End If
iSheet = iSheet + 1
lCount = lCount + lRow
Loop
Set shtInv = Nothing
Set shtRaw = Nothing
End Function