Macro to move row to another worksheet

emjeff99

Board Regular
Joined
Feb 16, 2006
Messages
55
Hi! I have a workbook with two worksheets in it. The first "TO DO" and the second "Completed". In "TO DO", I have rows of tasks starting in row 4 (row 3 is my header), going to 200. What I'd like to have happen is when I put a "C" in column C, it moves the entire row to the "Completed" worksheet, greys it out and removes it from the "TO DO" worksheet. Then if I remove the "C" from the "Completed" worksheet, it moves it back to the bottom of the list. I already have a macro to resort it based on "priority" in column E.

Is this even possible???

As always, thanks! You all are so awesome!!!
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
See if this does what you want:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#007F00">'   Code goes in the Worksheet specific module</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>        <SPAN style="color:#007F00">'   Set Target Range</SPAN><br>        Set rng = Target.Parent.Range("C4:C200")<br>             <SPAN style="color:#007F00">'   Only look at single cell changes</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>            <SPAN style="color:#007F00">'   Only look at that range</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>            <SPAN style="color:#007F00">'   Action if Condition(s) are met</SPAN><br>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Target.Text<br>                <SPAN style="color:#00007F">Case</SPAN> "C"<br>                    Target.EntireRow.Cut Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = ""<br>                    Target.EntireRow.Cut Sheets("To Do").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,
 
Upvote 0
See if this does what you want:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>****<SPAN style="color:#007F00">'** Code goes in the Worksheet specific module</SPAN><br>****<SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>********<SPAN style="color:#007F00">'** Set Target Range</SPAN><br>********Set rng = Target.Parent.Range("C4:C200")<br>************ <SPAN style="color:#007F00">'** Only look at single cell changes</SPAN><br>************<SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>************<SPAN style="color:#007F00">'** Only look at that range</SPAN><br>************<SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>************<SPAN style="color:#007F00">'** Action if Condition(s) are met</SPAN><br>************<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Target.Text<br>****************<SPAN style="color:#00007F">Case</SPAN> "C"<br>********************Target.EntireRow.Cut Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>****************<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = ""<br>********************Target.EntireRow.Cut Sheets("To Do").Cells(Rows.Count, "A").End(xlUp).Offset(1)<br>************<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

So I'm a big dork - I know next to nothing when writing macros. Do I just paste this into one? (sorry)
 
Upvote 0
Right-click the Excel icon (next to the File menu). That will open the ThisWorkbook module. Paste the code in the new window that opens on the right.

The code will run automatically whenever the changes you wanted happen in either sheet. If you enter "C" in C4:C200 in the To Do sheet, the row will be cut and pasted into the Completed sheet. If you delete the "C" in that sheet it will be cut back.
 
Upvote 0
Hi,

I'm looking for similar macro that copies entire row from sheet2 to sheet5 if cell value in column R is "0" and then deletes the source(sheet2) rows that were copied.;)
 
Upvote 0
Code:
Sub moveZeroRows()
Dim X As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For X = ActiveSheet.Cells(Rows.Count, "R").End(xlUp).Row To 1 Step -1
If ActiveSheet.Cells(X, "R").Value = 0 Then
ActiveSheet.Cells(X, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A1:A" & LastRow)

Application.ScreenUpdating = True
End If
Next
End Sub
I made this..but as you can see it's made poorly..i'm noob you know..
I'll get error on

Code:
ActiveSheet.Cells(X, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Range("A1:A" & LastRow)
And it's BLOODY slow..
 
Upvote 0
Sub test()

Dim x As Integer
x = 1
Application.ScreenUpdating = False
Do
If Cells(x, 18) = "0" Then 'Caps sensitive
Cells(x, 1).EntireRow.Copy
Sheets(5).Select
Cells(65000, 1).End(xlUp).Offset(0, 0).Select
ActiveSheet.Paste
Sheets(2).Select
End If
x = x + 1
Loop Until Cells(x, 1) = ""
Application.ScreenUpdating = True

End Sub

I tried to get this to work..
Actually it works. Slowly but faster than last. And it leaves copied rows still there, but how can i automatically remove them?
 
Upvote 0
So again.

This code is fast! But the problem is that it copies only the cell with 0 value, and leaves the source still. Now i'm really stuck and there is not coming more out of me..
Code:
Sub test()
Dim SourceSheet As Worksheet, destzero As Worksheet
Dim TotalRng As Range, zrow As Range
Dim destzerorow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Set SourceSheet = Worksheets("Sheet2")
Set destzero = Worksheets("Sheet5")

Set TotalRng = Range(SourceSheet.Range("R1"), SourceSheet.Range("R1:R" & LastRow))
destzerorow = 1

Application.ScreenUpdating = False
  For Each zrow In TotalRng
  Select Case Left(zrow, 1)
  
  Case "0"
    destzero.Cells(destzerorow, "A") = zrow
    destzerorow = destzerorow + 1

  Case Else
    Debug.Print "Error in sorting out 0 values from sheet!" & zrow.Address
  End Select
  Next
End Sub

So if someone could tell me, where is the mistake that takes cell instead of row and what to add, to get the row cut/pased not copied.
 
Upvote 0
Code:
Sub test()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For Each ce In Range("R1:R" & LastRow)
    Select Case ce.Value
      Case "0"
        Cells(ce.Row, "R").EntireRow.Cut Destination:=Sheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End Select
  Next ce
End Sub
Can anyone tell me, why this code won't move second row from source sheet?
And why it leaves empty rows behind, and why it wont work..as it should be at all?
 
Upvote 0

Forum statistics

Threads
1,224,271
Messages
6,177,619
Members
452,786
Latest member
k3calloway

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
Back
Top