J
JP
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
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