Hi All,

In a previous Thread: "Copy and Paste LAST ROW of data", Tom Ogilvy and Mike
Fogleman both provided me with Great VB code.

Tom's code copies the last row of (contiguous) data to the next blank row
below, across multiple worksheets.

Tom Ogilvy
Sub CopyLast()
Dim r1 as Range, r2 as Range
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
set r1 = sh.Columns(1).specialCells(xlConstants,xlNumbers). Areas(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

If possible, I would like to adjust the code, still copying the last row of
data BUT the data will be non-contiguous (one or more blank cells) in the row
and it will contain constants as well as formulae.

-------------------------------------------------------------------

Mike Fogleman also provided this treasu
Is there other data surrounding this contiguous data that we need to avoid?
If not, then this simple code will do it:

Sub test()
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows(LRow).Copy Rows(LRow + 1)
End Sub

I added the following lines to Mike's code but could not get it to goto each
worksheet in turn.
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
Next sh

Help very much appreciated.

Thanks
Sam

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

Sub test()
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows(LRow).Copy Rows(LRow + 1)
End Sub

I added the following lines to Mike's code but could not get it to goto each
worksheet in turn.
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
with sheets("Sheet2")
.Rows("1:10").Copy Destination:=sh.Rows(LRow + 1)
end with
Next sh


"Sam via OfficeKB.com" wrote:

Hi All,

In a previous Thread: "Copy and Paste LAST ROW of data", Tom Ogilvy and Mike
Fogleman both provided me with Great VB code.

Tom's code copies the last row of (contiguous) data to the next blank row
below, across multiple worksheets.

Tom Ogilvy
Sub CopyLast()
Dim r1 as Range, r2 as Range
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
set r1 = sh.Columns(1).specialCells(xlConstants,xlNumbers). Areas(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

If possible, I would like to adjust the code, still copying the last row of
data BUT the data will be non-contiguous (one or more blank cells) in the row
and it will contain constants as well as formulae.

-------------------------------------------------------------------

Mike Fogleman also provided this treasu
Is there other data surrounding this contiguous data that we need to avoid?
If not, then this simple code will do it:

Sub test()
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows(LRow).Copy Rows(LRow + 1)
End Sub

I added the following lines to Mike's code but could not get it to goto each
worksheet in turn.
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
Next sh

Help very much appreciated.

Thanks
Sam

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

Hi Joel,

Thank you very much for reply and assistance.

Dim LRow As Long
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
with sheets("Sheet2")
.Rows("1:10").Copy Destination:=sh.Rows(LRow + 1)
end with
Next sh
End Sub

The above does not produce the desired result. The sheets will not be
sequentially named and the number of rows on each sheet will vary.

Further help appreciated.

Cheers,
Sam

Joel wrote:
Sub test()
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows(LRow).Copy Rows(LRow + 1)
End Sub

I added the following lines to Mike's code but could not get it to goto each
worksheet in turn.
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
with sheets("Sheet2")
.Rows("1:10").Copy Destination:=sh.Rows(LRow + 1)
end with
Next sh

--
Message posted via http://www.officekb.com

What this code will do is copy the last row of sheet2 to the bottom of all
the sheets listed in the Array in the code below. Array can be in any order
and contain as many sheets as necessary (except sheet 2 cannot be in the
arrray).
Dim LRow As Long
Dim sh as worksheet

with sheets("Sheet2")
Sh2LRow = .Cells(Rows.Count, "A").End(xlUp).Row
end with
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
shLRow = sh.Cells(Rows.Count, "A").End(xlUp).Row
with sheets("Sheet2")
.Rows(Sh2LRow).Copy Destination:=sh.Rows(shLRow + 1)
end with
Next sh
End Sub


"Sam via OfficeKB.com" wrote:

Hi Joel,

Thank you very much for reply and assistance.

Dim LRow As Long
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
with sheets("Sheet2")
.Rows("1:10").Copy Destination:=sh.Rows(LRow + 1)
end with
Next sh
End Sub

The above does not produce the desired result. The sheets will not be
sequentially named and the number of rows on each sheet will vary.

Further help appreciated.

Cheers,
Sam

Joel wrote:
Sub test()
Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Rows(LRow).Copy Rows(LRow + 1)
End Sub

I added the following lines to Mike's code but could not get it to goto each
worksheet in turn.
Dim sh as worksheet
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
with sheets("Sheet2")
.Rows("1:10").Copy Destination:=sh.Rows(LRow + 1)
end with
Next sh

--
Message posted via http://www.officekb.com

Hi Joel,

Thank you for reply.

I actually need the last row of each sheet in the array to be copied to its
own sheet (the same sheet) but to the next empty row below.

Further help appreciated.

Cheers,
Sam

Joel wrote:
What this code will do is copy the last row of sheet2 to the bottom of all
the sheets listed in the Array in the code below. Array can be in any order
and contain as many sheets as necessary (except sheet 2 cannot be in the
arrray).
Dim LRow As Long
Dim sh as worksheet

with sheets("Sheet2")
Sh2LRow = .Cells(Rows.Count, "A").End(xlUp).Row
end with
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
shLRow = sh.Cells(Rows.Count, "A").End(xlUp).Row
with sheets("Sheet2")
.Rows(Sh2LRow).Copy Destination:=sh.Rows(shLRow + 1)
end with
Next sh
End Sub

--
Message posted via http://www.officekb.com

Sub CopyLast()
Dim LRow As Long
Dim sh As Worksheet

For Each sh In Worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, "A").End(xlUp).Row
sh.Rows(LRow).Copy Destination:=sh.Rows(LRow + 1)
Next sh
End Sub


"Sam via OfficeKB.com" wrote:

Hi Joel,

Thank you for reply.

I actually need the last row of each sheet in the array to be copied to its
own sheet (the same sheet) but to the next empty row below.

Further help appreciated.

Cheers,
Sam

Joel wrote:
What this code will do is copy the last row of sheet2 to the bottom of all
the sheets listed in the Array in the code below. Array can be in any order
and contain as many sheets as necessary (except sheet 2 cannot be in the
arrray).
Dim LRow As Long
Dim sh as worksheet

with sheets("Sheet2")
Sh2LRow = .Cells(Rows.Count, "A").End(xlUp).Row
end with
for each sh in worksheets(Array("sheet1", "sheet3", "sheet5"))
shLRow = sh.Cells(Rows.Count, "A").End(xlUp).Row
with sheets("Sheet2")
.Rows(Sh2LRow).Copy Destination:=sh.Rows(shLRow + 1)
end with
Next sh
End Sub

--
Message posted via http://www.officekb.com

Hi Joel,

Thank you very much for further assistance.

Your code does the job very well; very much appreciated.

Cheers,
Sam

Joel wrote:
Sub CopyLast()
Dim LRow As Long
Dim sh As Worksheet

For Each sh In Worksheets(Array("sheet1", "sheet3", "sheet5"))
LRow = sh.Cells(Rows.Count, "A").End(xlUp).Row
sh.Rows(LRow).Copy Destination:=sh.Rows(LRow + 1)
Next sh
End Sub

--
Message posted via http://www.officekb.com