Sam, this will work to some extent if there is data below the target range,
it is also contiguous, and there is only one section of data. I have also
modified the code to run on each sheet in the workbook, as you requested of
Tom.
If there are several areas of data below the target data, then we will need
a way to differentiate among them to find the range.

Sub test()
Dim LRow As Long
Dim MyRng As Range
Dim i As Long
Dim ws As Worksheet

For Each ws In Worksheets
ws.Activate
LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set MyRng = Range("A" & LRow)
i = MyRng.CurrentRegion.Rows.Count
i = LRow - i
If IsEmpty(Range("A" & i)) Then
i = i - 1
If i = 0 Then i = 1
Set MyRng = Range("A" & i)
Do While IsEmpty(MyRng)
i = i - 1
If i = 0 Then i = 1
Set MyRng = Range("A" & i)
If MyRng.Row = 1 Then
LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set MyRng = Range("A" & LRow)
Exit Do
End If
Loop
LRow = MyRng.Row
Range(MyRng, MyRng.End(xlToRight)).Copy Range("A" & LRow + 1)
End If
Next
Worksheets(1).Activate
End Sub

Mike F
"Sam via OfficeKB.com" <u4102@uwe wrote in message
news:77ea6409c2360@uwe...
Hi Mike,

Thank you very much indeed for your time and assistance.

Your code works Great!

However, if there is data further down in column A after some
blank cells then this will find it and copy that row. More code would be
needed to avoid data that is below the contiguous data in column A.

Would it be possible for you to extend your Sub test() routine and provide
the additional code that would take the above scenario into account.

Much appreciated.

Cheers,
Sam

Mike Fogleman wrote:
This one does exclude any data on the last row that is to the right of a
blank cell. However, if there is data further down in column A after some
blank cells then this will find it and copy that row. More code would be
needed to avoid data that is below the contiguous data in column A.

Sub test()
Dim LRow As Long
Dim MyRng As Range

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set MyRng = Range("A" & LRow)
Range(MyRng, MyRng.End(xlToRight)).Copy Range("A" & LRow + 1)
End Sub

Mike F

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200709/1