copy paste to first first open row

[JSnow]

I'm trying to copy/special paste a range of information to the first
available row on another sheet called 'Half Payout' or sheet2. When the user
chooses "yes" in any row in column L, the data from columns B:K in that same
row should get special pasted (value only) to the first open row on sheet2.
It doesn't work - the range gets copied and nothing gets special pasted.

Here's my code:
Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
On Error GoTo Whoops

If Target.Column = 12 Then 'column L Half Credit
If Target.Row > 5 Then
Dim rw As Integer
rw = Target.Row
Dim halfRange As String
halfRange = "B" & rw & ":K" & rw
If Target.Value = "yes" Then
Range(halfRange).Select 'this grabs the half credit policy
Selection.Copy
Sheet2.Range("B3:B8000").Find(What:="",
After:=Range("B3:B8000").Cells(1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False 'Clears clipboard.
End If
End If
End If


Whoops:
Application.EnableEvents = True

End Sub

Thanks for any direction.

 

[Per Jessen]

Hi

You miss the sheet reference in the paste special statement.

Here's how I would do it:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetRow As Long
Dim halfRange As String
Dim CopyToRow As Long

Application.EnableEvents = False
'On Error GoTo Whoops

If Target.Column = 12 Then 'column L Half Credit
If Target.Row > 5 Then
TargetRow = Target.Row
halfRange = "B" & TargetRow & ":K" & TargetRow
If Target.Value = "yes" Then ' Case sensitive
If Sheet2.Range("B3") = "" Then
CopyToRow = 3
Else
CopyToRow = Sheet2.Range("B2").End(xlDown).Row + 1 'Assume
headings in B2
End If
Range(halfRange).Copy
Sheet2.Range("B" & CopyToRow).PasteSpecial Paste:=xlPasteValues,
_
Operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False 'Clears clipboard.
End If
End If
End If
'Whoops:
Application.EnableEvents = True
End Sub

Regards,
Per

 

[JSnow]

Per, thank you! That was genius!

Hi

You miss the sheet reference in the paste special statement.

Here's how I would do it:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetRow As Long
Dim halfRange As String
Dim CopyToRow As Long

Application.EnableEvents = False
'On Error GoTo Whoops

If Target.Column = 12 Then 'column L Half Credit
If Target.Row > 5 Then
TargetRow = Target.Row
halfRange = "B" & TargetRow & ":K" & TargetRow
If Target.Value = "yes" Then ' Case sensitive
If Sheet2.Range("B3") = "" Then
CopyToRow = 3
Else
CopyToRow = Sheet2.Range("B2").End(xlDown).Row + 1 'Assume
headings in B2
End If
Range(halfRange).Copy
Sheet2.Range("B" & CopyToRow).PasteSpecial Paste:=xlPasteValues,
_
Operation:=xlNone, skipblanks:=False, Transpose:=False
Application.CutCopyMode = False 'Clears clipboard.
End If
End If
End If
'Whoops:
Application.EnableEvents = True
End Sub

Regards,
Per