Copy and paste a row of data based on the location of the active celll

[sncr137]

Hello Everyone,

I am in need of a macro that, upon a double click, copies the data in a row based on the active cell being located somewhere on that row. Once Copied I would like it to paste the selected row into the next sheet in the next empty row.

The first row is D1 to J1 and then goes down from there. If I select D1 or J1 I would like it to copy the data from D1 to J1. Then Paste that data to the next sheet in the next available cell starting in B3.

I am very much a beginner and need some community help. Thank You.

 

[MARK858]

Didn't read the whole question, will post back

 

[MARK858]

Try...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LR As Long
    If ActiveCell = Cells(Target.Row, "D") Or ActiveCell = Cells(Target.Row, "J") Then
        LR = Sheets(ActiveSheet.Index + 1).Range("B" & Rows.Count).End(xlUp).Row
        If LR < 2 Then LR = 2
        Intersect(Rows(Target.Row), Columns("d:j")).Copy Destination:=Sheets(ActiveSheet.Index + 1).Range("B" & LR).Offset(1)
    End If
End Sub

 

[MARK858]

Should have stated that the code in the previous post goes in the worksheet module of the sheet you are copying from.
Right click the sheet tab, click View Code, and paste the code in the white area.

 

[sncr137]

Will I have to set the destination to the page I want the data to go to?

 

[MARK858]

You stated that you wanted it pasted to the next sheet.

paste the selected row into the next sheet in the next empty row.

The code pastes to the next sheet (the sheet 1 to the right of the sheet you are copying from)

 

[sncr137]

Doesn't seem to work. Here is a copy of the code. My sheets are named "Ordering" and "Shopping Cart". I would like it to go from the "Ordering" sheet to the Next available cell on the "Shopping Cart" Worksheet. The first code is to highlight a selection and then if they double click that selection, anything highlighted goes to the "Shopping Cart" sheet.

This is creating a list on the secondary sheet, so as they double click things it keeps adding to the list.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rownumber As Integer

rownumber = ActiveCell.Row

If Application.Intersect(ActiveCell, [Headers]) Is Nothing Then

If ActiveCell.Value <> "" Then

Range("d4:k5000").Interior.ColorIndex = xlNone

Range("D" & rownumber & ":k" & rownumber).Interior.Color = RGB(255, 255, 9)

End If

End If

End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim LR As Long

If ActiveCell = Cells(Target.Row, "D") Or ActiveCell = Cells(Target.Row, "K") Then

LR = Sheets(ActiveSheet.Index + 1).Range("B" & Rows.Count).End(xlUp).Row

If LR < 2 Then LR = 2

Intersect(Rows(Target.Row), Columns("d:k")).Copy Destination:=Sheets(ActiveSheet.Index + 1).Range("B" & LR).Offset(1)

End If

End Sub

 

[MARK858]

First of all comment out the other code as there is no point having another code running and possibly interfering with the code when you don't know if the new code is working.

Then put the code below in the "Ordering" sheet. Then if you double click anywhere inbetween columns D & J then that row between those columns will be copied.

Just a pointer but for any future postings you make if you want things to happen to a specific sheet then state it rather than use words like next or else you won't get what you are expecting.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LR As Long
    If Not Intersect(Target, Range(Cells(Target.Row, "D"), Cells(Target.Row, "J"))) Is Nothing Then
        LR = Sheets("Shopping Cart").Range("B" & Rows.Count).End(xlUp).Row
        If LR < 2 Then LR = 2
        Intersect(Rows(Target.Row), Columns("d:j")).Copy Destination:=Sheets("Shopping Cart").Range("B" & LR).Offset(1)
    End If
End Sub

Doesn't seem to work.

If the above doesn't do what you want then explain exactly what is wrong and what you want rather that a throwaway statement like "doesn't seem to work"

 

[sncr137]

Your Advice has been heard. No more throw aways.

Code works beautifully. Works with the other code commented out and with it active.

Truly appreciate the help.

 

[MARK858]

Happy it helped and welcome to the forum.