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)