Moving and Deleting rows from one worksheet to another

C_Bolton123

New Member
Joined
Feb 12, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hi There!
I've seen previous questions on how to move a row from one worksheet to another when marked as "completed", and have copied the code and made it work for me - so thank you!
But now I'd like to delete that row from the first sheet, so it only appears on the second sheet, titled "Completed Projects".
Can anyone help me with this?

Thanks so much!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
423
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

Check below code:

If unable to modify as per existing code, please share your previous code.

VBA Code:
Sub copyDelete()
Dim source As Worksheet
Dim dest As Worksheet

Set source = Sheets("Sheet1")
Set dest = Sheets("Sheet2")

source.Range("1:1").Copy

dest.Activate
dest.Range("A1").Select
dest.Paste

source.Range("1:1").Delete
End Sub
 

C_Bolton123

New Member
Joined
Feb 12, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Sub copyDelete() Dim source As Worksheet Dim dest As Worksheet Set source = Sheets("Sheet1") Set dest = Sheets("Sheet2") source.Range("1:1").Copy dest.Activate dest.Range("A1").Select dest.Paste source.Range("1:1").Delete End Sub
Hi Saurabhj - thank you for your help!
Here's the original code I used :

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/21/2020 9:01:00 AM EST
If Target.Column = 8 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Dim SheetName As String
SheetName = "Completed Projects"
Dim SearchValue As String
SearchValue = "Completed"
If Target.Value = SearchValue Then
Lastrow = Sheets(SheetName).Cells(Rows.Count, 5).End(xlUp).Row + 1
Rows(Target.Row).Copy Sheets(SheetName).Rows(Lastrow)
End If
End If
End Sub

Silly question, If I want to add your code, do I set up as a new code or paste below this one and make updates to the sheet name?
Thank you so much!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,975
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("H2:H" & Rows.Count)) Is Nothing Then
      If Target.Value = "Completed" Then
         Target.EntireRow.Copy Sheets("Completed Projects").Range("H" & Rows.Count).End(xlUp).Offset(1, -7)
         Target.EntireRow.Delete
      End If
   End If
End Sub
 

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
423
Office Version
  1. 365
  2. 2019
Platform
  1. Windows

ADVERTISEMENT

Silly question, If I want to add your code, do I set up as a new code or paste below this one and make updates to the sheet name?
Thank you so much!
Hi, you need to add a line in your code.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/21/2020 9:01:00 AM EST
If Target.Column = 8 Then
       If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
       Dim Lastrow As Long
       Dim SheetName As String
        SheetName = "Completed Projects"
       Dim SearchValue As String
       SearchValue = "Completed"
       If Target.Value = SearchValue Then
                 Lastrow = Sheets(SheetName).Cells(Rows.Count, 5).End(xlUp).Row + 1
                 Rows(Target.Row).Copy Sheets(SheetName).Rows(Lastrow)
                 Target.EntireRow.Delete                                                                 'Add this line
      End If
End If
End Sub
 

C_Bolton123

New Member
Joined
Feb 12, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hi, you need to add a line in your code.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/21/2020 9:01:00 AM EST
If Target.Column = 8 Then
       If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
       Dim Lastrow As Long
       Dim SheetName As String
        SheetName = "Completed Projects"
       Dim SearchValue As String
       SearchValue = "Completed"
       If Target.Value = SearchValue Then
                 Lastrow = Sheets(SheetName).Cells(Rows.Count, 5).End(xlUp).Row + 1
                 Rows(Target.Row).Copy Sheets(SheetName).Rows(Lastrow)
                 Target.EntireRow.Delete                                                                 'Add this line
      End If
End If
End Sub
This is awesome - thank you so much!!
 

Watch MrExcel Video

Forum statistics

Threads
1,130,362
Messages
5,641,697
Members
417,229
Latest member
BODYCOTE

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top