ExcelBanter

Here arre two solutions that are very similar. The second copies the entire
row rather than the range A to AM. The destination of a copy only has to be
the first cell in most cases.

Sub test()

finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row

Do Until Worksheets("Daily Summary").Range("A" & finalrow).Value = TodaysDate
Worksheets("Daily Summary").Range("A" & finalrow & ":AM" &
finalrow).Copy _
Destination:=Worksheets("Daily Summary").Range("A" & (finalrow + 1))
finalrow = finalrow + 1
Loop

End Sub
Sub test2()

finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row

Do Until Worksheets("Daily Summary").Range("A" & finalrow).Value = TodaysDate
Worksheets("Daily Summary").Rows(finalrow).Copy _
Destination:=Worksheets("Daily Summary").Rows(finalrow + 1)
finalrow = finalrow + 1
Loop

End Sub

"Richard" wrote:

Hi

I have the follwoing loop,

finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row
Set RNGd = Worksheets("Daily Summary").Cells(finalrow, 1)
Do Until Worksheets("Daily Summary").Range(RNGd, RNGd).Value = TodaysDate
Worksheets("Daily Summary").Range(RNGd, RNGd.Offset(0, 39)).Copy
Destination:=Worksheets("Daily Summary").Range(RNGd, RNGd.Offset(0,
39)).Offset(1, 0)
finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row
Set RNGd = Worksheets("Daily Summary").Cells(finalrow, 1)
Loop

Which basically checks the last cell in column A and if the date isn't equal
to today, it copies that row to the next empty row. The loop keeps going
until the final cell is equal to todays date.

1) Is there a better way of writing this code.

2) Specifically, I have to keep restating the final row and RNGd, can this
be avoided.

Thanks and Regards
Richard