Thread: Move entire row to another worksheet based on cell value

bdf0827,


Please do not click on the Quote message in reply? button/box when replying.


It makes it difficult trying to determine what you are asking for, and to whom you are replying.


The reason that the macros are not working correctly is beacuse the Total line in worksheets Booked and DNMQ is NOT in a constant row.


The following macro looks for the row that the text Potential is in, in the two receiving worksheets, and then determines the next available row in column D that is blank.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run, worksheet Current

3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' stanleydgromjr, 09/05/2011
' Version 3, after copying the Target.Row, delete the Target.Row
' http://www.excelforum.com/excel-programming/790860-move-entire-row-to-another-worksheet-based-on-cell-value.html
If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim P As Long, NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "Booked"
      P = Application.Match("Potential", Worksheets("Booked").Columns(4), 0)
      NR = Worksheets("Booked").Range("D" & P).End(xlUp).Offset(1).Row
      Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Booked").Range("A" & NR)
      Rows(Target.Row).Delete
    Case "DNMQ"
      P = Application.Match("Potential", Worksheets("DNMQ").Columns(4), 0)
      NR = Worksheets("DNMQ").Range("D" & P).End(xlUp).Offset(1).Row
      Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("DNMQ").Range("A" & NR)
      Rows(Target.Row).Delete
  End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

bdf0827,

It would really make it easier if you did not quote your helpers entire post - it is hard to follow what is being requested.


Your worksheets Booked and DNMQ have their TOTAL row in a different position.


The below macro will work correctly until all the enpty rows in column D, between Status and Potential have all been used up.



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run, worksheet Current
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' stanleydgromjr, 09/28/2011
' Version 3, after copying the Target.Row, delete the Target.Row
' http://www.excelforum.com/excel-programming/790860-move-entire-row-to-another-worksheet-based-on-cell-value.html
If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim FR As Long, NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "Booked"
      FR = Application.Match("Potential", Worksheets("Booked").Columns(4), 0)
      NR = Worksheets("Booked").Range("D" & FR).End(xlUp).Offset(1).Row
      Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Booked").Range("A" & NR)
      Rows(Target.Row).Delete
    Case "DNMQ"
      FR = Application.Match("Potential", Worksheets("DNMQ").Columns(4), 0)
      NR = Worksheets("DNMQ").Range("D" & FR).End(xlUp).Offset(1).Row
      Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("DNMQ").Range("A" & NR)
      Rows(Target.Row).Delete
  End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

Then make changes in worksheet Current, column D.