Worksheet Change Copy Paste to Another Sheet

[kjacob318]

Hello,

I have two sheets, "Current" and "Complete". Basically when one task in the "Current" sheet is completed, I want it to run a macro to copy and paste to the "Complete" sheet.

Most of my code is working. It is finding the correct row and cells needed to copy, but it is not pasting in the new sheet. Does anyone know what could be happening?

'Determine Full Ranges
                WS_Current.Select
                    lastrow_current = Cells(Rows.Count, 3).End(xlUp).Row
                    lastcolumn_current = Cells(7, Columns.Count).End(xlToLeft).Column
        
                WS_Completed.Select
                    lastrow_completed = Cells(Rows.Count, 3).End(xlUp).Row
                    lastcolumn_completed = Cells(7, Columns.Count).End(xlToLeft).Column
                    
                'Copy Task Item
                WS_Current.Range(Cells(Find_Y, 3), Cells(Find_Y, lastcolumn_current)).Copy WS_Completed.Range(Cells(lastrow_completed + 1, 3), Cells(lastrow_completed, lastcolumn_completed))

                'Paste Completed Task
                WS_Completed.Select
                    Range(Cells(lastrow_completed + 1, 3), Cells(lastrow_completed, lastcolumn_completed)).Select
                    ActiveSheet.Paste
                    Application.CutCopyMode = False

 

[My Aswer Is This]

This cannot be your entire script. Please show us the entire script.

 

[kjacob318]

This cannot be your entire script. Please show us the entire script.

Below is the entire script. Basically if there is a Y in the completed column, it will ask the user if the task was completed. On yes, move the row to the "Completed" tab.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim WS_Current As Worksheet
Set WS_Current = Sheets("Current")
Dim WS_Completed As Worksheet
Set WS_Completed = Sheets("Completed")

WS_Current.Select
        lastrow_current = Cells(Rows.Count, 3).End(xlUp).Row
        lastcolumn_current = Cells(7, Columns.Count).End(xlToLeft).Column

If Not Intersect(Target, Range(Cells(8, lastcolumn_current), Cells(lastrow_current, lastcolumn_current))) Is Nothing Then
    On Error GoTo No_Y_Found:
       'Find Variables
        Complete_Column = WS_Current.Rows(7).Find(What:="Complete?", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Column
        Find_Y = WS_Current.Columns(Complete_Column).Find(What:="Y", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
        Description_Column = WS_Current.Rows(7).Find(What:="Description", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Column
    
    Dim Description_Completed As String
    Description_Completed = Cells(Find_Y, Description_Column)
    
    
    ChangedCell = MsgBox("Completed Hot List Item: " & vbNewLine & Description_Completed, vbYesNo)
        Select Case ChangedCell
            Case vbNo
                Cells(Find_Y, Complete_Column).Select
                ActiveCell.FormulaR1C1 = ""
            Case vbYes
                'Determine Ranges
                WS_Current.Select
                    lastrow_current = Cells(Rows.Count, 3).End(xlUp).Row
                    lastcolumn_current = Cells(7, Columns.Count).End(xlToLeft).Column
        
                WS_Completed.Select
                    lastrow_completed = Cells(Rows.Count, 3).End(xlUp).Row
                    lastcolumn_completed = Cells(7, Columns.Count).End(xlToLeft).Column
                    
                'Copy Task Item
                WS_Current.Range(Cells(Find_Y, 3), Cells(Find_Y, lastcolumn_current)).Copy WS_Completed.Range(Cells(lastrow_completed + 1, 3), Cells(lastrow_completed, lastcolumn_completed))
                'Paste Completed Task
                WS_Completed.Select
                    Range(Cells(lastrow_completed + 1, 3), Cells(lastrow_completed, lastcolumn_completed - 1)).Select
                    ActiveSheet.Paste
                    Application.CutCopyMode = False
                
                
                'Insert Complete Date
                WS_Completed.Select
                    Cells(lastrow_completed + 1, lastcolumn_completed).Select
                    ActiveCell.FormulaR1C1 = "=Today()"
                    Selection.Copy
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            Application.CutCopyMode = False
                    
                    
                'Delete Row in Current Sheet
                WS_Current.Select
                    Rows(Find_Y).EntireRow.Delete
                    
                    
                'Re-Number Tasks in Current Sheet
                    Cells(8, 3).Select
                    ActiveCell.FormulaR1C1 = "1"
                    
                    For XX = 9 To lastrow_current - 1
                        ActiveCell.FormulaR1C1 = "=R[-1]C+1"
                        Selection.Copy
                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            Application.CutCopyMode = False
                    Next XX
        End Select
Else
End If
Application.ScreenUpdating = True
No_Y_Found:
Exit Sub
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

The below script will do basically what you asked for.
If you have the value "Y" Upper case "Y" in column 3 and you double click on column "A" of same row that rows data will be copied to sheet named "Complete" And the row on sheet "Current" will be deleted.
You said Y in the completed column since I do not know what completed column is I set script to look in column 3 if that is wrong modify the script where indicated in red.

I think double click is a lot easier and eliminates accidental actions from happening and does not require a message box.

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet "Current"
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Cancel = True
Dim col As Long
[COLOR=#FF0000]col = 3[/COLOR] 'This looks for "Y" in column 3 if that is wrong change to what it should be
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row + 1
    If Cells(Target.Row, col).Value = "Y" Then
        Rows(Target.Row).Copy Destination:=Sheets("Completed").Rows(Lastrow)
        Rows(Target.Row).Delete
    End If
End If
End Sub

]

 

[kjacob318]

Worked Great!! Thank you for all the help!

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

Worked Great!! Thank you for all the help!