Easy Cut & Paste to duplicate sheet

[Roderick_E]

My company uses a lot of spreadsheets where there are 2 tabs; one for "active" and another for "completed". The user typically will cut and paste a completed row from the active sheet to the completed sheet. Both sheets have exact same headers.

To automate this, I created code so that the user merely needs to double click on the row to "move" it to the next blank row on the "completed" tab.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lastrow As Long
Dim nextrow As Long
Dim sselrow As String
Dim rselrow As String
On Error Resume Next
lastrow = 1
lastrow = Sheet2.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
Resume Next
Cancel = True
sselrow = ActiveCell.Row & ":" & ActiveCell.Row
Rows(sselrow).Select
    Selection.Cut
    Sheet2.Select
    rselrow = lastrow & ":" & lastrow
    Sheet2.Rows(rselrow).Select
    ActiveSheet.Paste
    Sheet1.Select
    Sheet1.Rows(sselrow).Select
    Selection.Delete Shift:=xlUp
End Sub

The above code would go ONLY on the "active" tab by right clicking the tab and VIEW CODE - paste it in.
Keep in mind it assumes "active" tab is Sheet1 and "completed" tab is Sheet2. Modify as needed.

 

[dave3009]

Hi

I think this might do roughly what you want it to do, see how it goes and if it needs a tweak post back and I'll amend it.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lastrow As Long
Dim r As Range
With Application
    .ScreenUpdating = False
        lastrow = Sheets("complete").Range("A" & Rows.Count).End(xlUp).Row + 1
        With ActiveCell
            .EntireRow.Copy Sheets("complete").Range("A" & lastrow)
            .EntireRow.Delete xlUp
        End With
        Cancel = True
    .ScreenUpdating = True
End With
End Sub