I won't open that message.

Please keep the discussion in the newsgroup and describe your question in plain
text.

You'll get the added benefit of lots of readers and lots of potential
responders.

JP wrote:

Thanks for your reply Dave... this did not achieve the desired result so I
have sent to you a copy of the spreadsheet and some further information.

Thanks again for your assistance!

JP

"Dave Peterson" wrote:

Maybe something like this (untested):

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
dim myRngToCheck as range
dim myCell as range
set myrngtocheck = intersect(me.columns(57),target)
if myrngtocheck is nothing then exit sub

for each mycell in myrngtocheck.cells
On Error Resume Next
If UCase(mycell.Value) = "YES" Then
Application.EnableEvents = False
With me 'sheet that owns the code
.Range(.Cells(mycell.Row, 49), .Cells(mycell.Row, 51)).Copy
Worksheets("Demolition Package 1").Cells(mycell.Row - 4, 1) _
.PasteSpecial Paste:=xlPasteValues
end with
Application.EnableEvents = True
End If

.....


JP wrote:

I have a spreadsheet with multiple worksheets. On the Master spreadsheet I
have a column with a validation list giving users a "YES" or "NO" option. If
they select the "YES" option then it copies the data in the target,row cells
49,50,51 and pastes it into another worksheet. By selecting the "NO" option
it will clear the contents of those cells.

The issue that I have is that there will be up to 1000 rows to which an
individual "YES" or "NO" selection will need to be made. To make this faster
I would like to be able to click and drag the "YES" response to multiple
cells where appropriate.

What is the correction I need to make to the following code to allow this to
happen?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column < 57 Then Exit Sub
On Error Resume Next
If UCase(Target.Value) = "YES" Then
Application.EnableEvents = False
With ActiveSheet
.Range(.Cells(Target.Row, 49), .Cells(Target.Row, 51)).Copy
Worksheets("Demolition Package 1").Cells(Target.Row - 4,
1).PasteSpecial Paste:=xlPasteValues
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
Application.CutCopyMode = False
End With
Application.EnableEvents = True
End If

--

Dave Peterson


--

Dave Peterson