Expand VBA code to search Column & Paste Cells to Other Sheet

[Domcast]

Hello, I have a spreadsheet used for others to request materials and each row contains a macro to copy specific cells in the row and paste on another sheet when button is pressed. As this list grows I don't want to keep making buttons for each row, instead I would like to have 1 macro button that copies the specific cells in that row and paste it to another sheet when the button is pressed. Each row has this exact VBA code but the row number changes for each. The column I need it to look at is "J" and if anything above "0" entered copy that row cells C,E,H,J and paste it to another sheet. I've been working on this for a while but can seem to figure this one out. Any help will be appreciated.




Currently my macro button is:

Private Sub CommandButton1_Click()

If (Range("J3") = "0") Then

MsgBox "A QUANTITY WAS NOT ENTERED"

Else

erw = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count + 1

Sheet2.Cells(erw, 1) = Range("C3")

Sheet2.Cells(erw, 2) = Range("E3")

Sheet2.Cells(erw, 3) = Range("H3")

Sheet2.Cells(erw, 4) = Range("J3")

Range("J3") = "0"

End If

End Sub


Thank you.

[Paul_Hossler]

maybe a Double Click event on Sheet1



Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Range
Dim erw As Long

Set r = Target.Cells(1, 1)

If r.Row = 1 Then Exit Sub
If r.Column <> 10 Then Exit Sub

If r.Value = 0 Then
MsgBox "A QUANTITY WAS NOT ENTERED"
Exit Sub
End If

erw = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count + 1
Sheet2.Cells(erw, 1).Value = r.EntireRow.Cells(3).Value
Sheet2.Cells(erw, 2).Value = r.EntireRow.Cells(5).Value
Sheet2.Cells(erw, 3).Value = r.EntireRow.Cells(8).Value
Sheet2.Cells(erw, 4).Value = r.Value


r.Value = 0


End Sub

[Domcast]

I keep getting a run time error for


Set r = Target.Cells(1, 1)

Any idea?

[Paul_Hossler]

1. Does the attached Example.xlsm work?

2. If you put the macro into your own workbook, did you put it on the worksheet's code module?

3. maybe make a small debug change



Msgbox Target.address

Set r = Target.Cells(1, 1)