on _SelectionChange Copy Range to Second Worksheet

D

Dan

I have 2 worksheets. Whenever the active cell is changed in sheet 1 I want to copy the contents of the current row plus the next 5 rows to the top of Worksheet 2. Depending on what row is active will determine where the row selection will start for the copy.

I am using VB and Excel 2002

Thanks in advance - Dan
 
D

Doug Glancy

Dan,

Does this do what you want?

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)

If Sh.Name = "Sheet1" Then
Target.EntireRow.Resize(6).Copy _
Destination:=Sheet2.Range("A1")
End If

End Sub

hth,

Doug

Dan said:
I have 2 worksheets. Whenever the active cell is changed in sheet 1 I want
to copy the contents of the current row plus the next 5 rows to the top of
Worksheet 2. Depending on what row is active will determine where the row
selection will start for the copy.
 
D

DSC

How about this

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Range("A1:A6").EntireRow.Copy
Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1
0).PasteSpecial
Target.Offset(100, 0).Range("A1:A6").EntireRow.Copy
Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1
0).PasteSpecial
End Sub

placed in the worksheet you want to copy from

Davi
 
D

Doug Glancy

Dan,

I think the loop was probably because the sheet names I used may not apply
and it was trying to paste into the sheet it copied from. BTW you can stop
a loop with ctrl-break inside Excel (I have a lot of practice!).

Anyways if you paste this code into "Sheet1" it should copy as you want into
"Sheet2". Modify the sheet names to suit your book. To copy into Sheet1
right click on the sheet tab, choose View Code and paste. Note that this
code will crash if you are within 106 rows of the bottom of the sheet (row
65400):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Target.EntireRow.Resize(6).Copy _
Destination:=Sheet2.Range("A1")
Rows(Target.Row + 100).EntireRow.Resize(6).Copy _
Destination:=Worksheets("Sheet2").Range("A7")

End Sub

hth,

Doug

Dan said:
Doug,

The code you passed on causes an endless loop which I have to shut down
with task manager. Another feature that I didn't include in the initial post
is that I also want to grab a block of 6 rows a 100 down from the current
location as well and paste this to sheet2.
 
D

Dan

Doug

This works great! Thanks for your help and have a good holiday weekend

Regards - Dan
 
Top