I would like to improve this code where I take 5 rows and when done
move to the other account which is different.

Thx

Mat

'Loop for Positive

For b = 2 To 5000

lastrow = ActiveCell.Offset(5, 0).Row

Do Until b = lastrow
Cells(b, 7).Select
Range(Cells(b, 7), Cells(b, 10)).Select
Selection.Copy
Windows("RPACSTAR.XLS").Activate
Sheets("OUTPUT").Select
Range("A5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Windows("RPX.XLS").Activate
b = b + 1
Loop
Exit For

Next b

For c = b To 2000

If Cells(c, 7) < Cells(c + 1, 7) Or Cells(c, 8) < Cells(c + 1, 8)
Then
Cells(c + 1, 7).Select
Exit For
End If

Next c

For d = c + 1 To 2000

lastrow = ActiveCell.Offset(5, 0).Row

Do Until d = lastrow
Cells(d, 7).Select
Range(Cells(d, 7), Cells(d, 10)).Select
Selection.Copy
Windows("RPACSTAR.XLS").Activate
Sheets("OUTPUT").Select
Range("A5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Windows("RPX.XLS").Activate
d = d + 1
Loop
Exit For

Next d

For e = d To 2000

If Cells(e, 7) < Cells(e + 1, 7) Or Cells(e, 8) < Cells(e + 1, 8)
Then
Cells(e + 1, 7).Select
Exit For
End If

Next e

Mat wrote in message
om...
I would like to improve this code where I take 5 rows and when done
move to the other account which is different.


For b = 2 To 5000

lastrow = ActiveCell.Offset(5, 0).Row

Do Until b = lastrow
Cells(b, 7).Select
Range(Cells(b, 7), Cells(b, 10)).Select
Selection.Copy
Windows("RPACSTAR.XLS").Activate
Sheets("OUTPUT").Select
Range("A5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Windows("RPX.XLS").Activate
b = b + 1
Loop
Exit For

Next b

You don't really need to move the activecell about! Below is the above code
compacted. I have missed the ""sheets("Output").select"" line out, this
sheet could be selected before the for next loop

For b = 2 To 5000
lastrow = ActiveCell.Offset(5, 0).Row
Do Until b = lastrow
Range(Cells(b, 7), Cells(b, 10)).Copy
Windows("RPACSTAR.XLS").Activate
Range("A5000").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Windows("RPX.XLS").Activate
b = b + 1
Loop
Exit For

even better....(the long line begining with Windows may of wrapped!)

For b = 2 To 5000
lastrow = ActiveCell.Offset(5, 0).Row
Do Until b = lastrow
Range(Cells(b, 7), Cells(b, 10)).Copy

Windows("RPACSTAR.XLS").Worksheets("Output").Range ("A5000").End(xlUp).Offset
(1, 0).PasteSpecial (xlPasteAll)
b = b + 1
Loop
Next b

Stuart wrote in message
...

Mat wrote in message
om...
I would like to improve this code where I take 5 rows and when done
move to the other account which is different.


For b = 2 To 5000

lastrow = ActiveCell.Offset(5, 0).Row

Do Until b = lastrow
Cells(b, 7).Select
Range(Cells(b, 7), Cells(b, 10)).Select
Selection.Copy
Windows("RPACSTAR.XLS").Activate
Sheets("OUTPUT").Select
Range("A5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Windows("RPX.XLS").Activate
b = b + 1
Loop
Exit For

Next b

You don't really need to move the activecell about! Below is the above
code
compacted. I have missed the ""sheets("Output").select"" line out, this
sheet could be selected before the for next loop

For b = 2 To 5000
lastrow = ActiveCell.Offset(5, 0).Row
Do Until b = lastrow
Range(Cells(b, 7), Cells(b, 10)).Copy
Windows("RPACSTAR.XLS").Activate
Range("A5000").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Windows("RPX.XLS").Activate
b = b + 1
Loop
Exit For

Why not do it all in one step?

Cells(2, 7).Resize(ActiveCell.Offset(5, 0).Row - 2, 4).Copy _
Destination:=Workbooks("RPACSTAR.XLS").Worksheets( _
"Output").Range("A5000").End(xlUp).Offset(1, 0)

or, if you just want to copy values, you can avoid the Copy
altogether:

With Cells(2, 7).Resize(ActiveCell.Offset(5, 0).Row - 2, 4)
Workbooks("RPACSTAR.XLS").Worksheets( _
"Output").Range("A5000").End(xlUp).Offset(1, 0).Resize( _
.Rows.Count, .Columns.Count).Value = .Value
End With

In article ,
"Stuart" wrote:

even better....(the long line begining with Windows may of wrapped!)

For b = 2 To 5000
lastrow = ActiveCell.Offset(5, 0).Row
Do Until b = lastrow
Range(Cells(b, 7), Cells(b, 10)).Copy

Windows("RPACSTAR.XLS").Worksheets("Output").Range ("A5000").End(xlUp).Offset
(1, 0).PasteSpecial (xlPasteAll)
b = b + 1
Loop
Next b