PC Review


Reply
Thread Tools Rate Thread

Copy and Paste LAST ROW of data non-contiguous

 
 
Sam via OfficeKB.com
Guest
Posts: n/a
 
      27th Oct 2007
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 treasure:
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

 
Reply With Quote
 
 
 
 
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
 
      27th Oct 2007
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 treasure:
> 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
>
>

 
Reply With Quote
 
Sam via OfficeKB.com
Guest
Posts: n/a
 
      27th Oct 2007
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

 
Reply With Quote
 
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
 
      27th Oct 2007
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
>
>

 
Reply With Quote
 
Sam via OfficeKB.com
Guest
Posts: n/a
 
      27th Oct 2007
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

 
Reply With Quote
 
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
 
      29th Oct 2007
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
>
>

 
Reply With Quote
 
Sam via OfficeKB.com
Guest
Posts: n/a
 
      29th Oct 2007
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

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy non-contiguous columns (excel) and paste as table into ppt intoit Microsoft Powerpoint 0 17th Jul 2009 05:22 AM
Copy contiguous from one sheet and paste to another every other ro Dean Microsoft Excel Programming 1 12th May 2009 09:04 PM
Copy and Paste LAST ROW of data: non-contiguous Row, contiguous Column Sam via OfficeKB.com Microsoft Excel Programming 8 5th Nov 2007 07:18 PM
Paste Data into Contiguous (Visible) Cells trev_sk8r Microsoft Excel New Users 1 16th Jun 2006 10:04 PM
Copy and paste non-contiguous columns spasmous Microsoft Excel Discussion 4 12th Apr 2006 09:25 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 05:13 AM.