After investing more time, I guess he means if there are multiple areas in
column A.

Assuming the values are constants and not formulas, then this modification
should handle that.

Sub CopyLast()
Dim r1 as Range, r2 as Range
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
set r1 = Columns(1).specialCells(xlConstants,xlNumbers).Are as(1)
set r1 = r1(r1.count)
if isempty(r1(1,2)) then
set r2 = r1
else
set r2 = r1.end(xltoRight)
end if
Range(r1,r2).Copy r1(2)
Next sh
End Sub

this assumes going down column A

1 or more blank cells

a contiguous range of cells with number constants

at least one blank cell (then there may be:

other data in cells including blanks. )

If it is different from that, say how different.

--
Regards,
Tom Ogilvy


"Tom Ogilvy" wrote:

I am not sure what dragon Mike is trying to slay - I didn't see it in your
initial description. I guess cells(rows.count,1).offset(1,1) being not
empty, but then I am not sure why you would be copying data to that row.

anyway

Sub CopyLast()
Dim r1 as Range, r2 as Range
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
set r1 = cells(rows.count,1).End(xlup)
if isempty(r1(1,2)) then
set r2 = r1
else
set r2 = r1.end(xltoRight)
end if
Range(r1,r2).Copy r1(2)
Next sh
End Sub

--
Regards,
Tom Ogilvy



"Sam via OfficeKB.com" wrote:

Hi Mike,

Thank you for additional help.

When I run Sub test(), I get run-time error '1004' on this line: If IsEmpty
(Range("A" & i)) Then

error message Method 'range' of object '_Global' failed.

I have also modified the code to run on each sheet in the workbook, as you requested of
Tom.

Could the above be specific sheets I list in an array, rather than all sheets?


Please advise.

Very much appreciated.

Cheers,
Sam

Mike Fogleman wrote:
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 "ERROR returned"
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

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