Move expanding selection of cells to new tabs based on condition

[LeeLee17]

I would appreciate an assist with vba code that moves adjacent cells from one sheet to another. The loop will be based on a DV selection: Next, None or Completed. The DV column will reside in all sheets at “A”. As the data moves through the work process move (not copy) data is collected and the number of adjacent cells grows. It will need to find the last row in the new tab to paste to. Thank you for your expertise and time.

 

[LeeLee17]

If we wanted to get really clever, we could even pass in the destination sheet name as a parameter, so you could re-use this code for all your moves. You would still need a small procedure attached to each button telling it which values to pass. Clever is always intriguing, what other info so you need from me?

 

[Joe4]

since column A is being used to direct to move data, I am guessing that may not always have values in it. So I used column B. That can easily be changed, if there is a better column to use.- This is interesting because theoretically there will be times when there is nothing in a particular process but the headers...

No, I am not talking about the destination sheets. I am talking about the rows with data that are being marked to move. There would be no point in marking a blank row to be moved, right?

If we wanted to get really clever, we could even pass in the destination sheet name as a parameter, so you could re-use this code for all your moves. You would still need a small procedure attached to each button telling it which values to pass. Clever is always intriguing, what other info so you need from me?

OK, here is what I came up with (and I changed it so that it only moves from column B, and copies to the last column, whatever that may be).
So, put all of this code in a General module (not in any of the sheet modules).

First, we have our "generic" move code with parameter than looks like this:

Private Sub MoveData(sh As String)
'   Pass the sheet name you want to move to as the parameter ("sh")

    Dim ws As Worksheet
    Dim lr As Long
    Dim r As Long
    Dim lc As Long
    Dim nr As Long
    
'   Capture active sheet
    Set ws = ActiveSheet
    
    Application.ScreenUpdating = False
    
'   Find last row in column with data
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows in sheet backwards up to row 4
    For r = lr To 4 Step -1
'       Check to see if cell A matches sought out value
        If ws.Cells(r, "A").Value = sh Then
'           Find last column with data in row
            lc = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
'           Find next available row on destination sheet, using column B
            nr = Sheets(sh).Cells(Sheets(sh).Rows.Count, "B").End(xlUp).Row + 1
'           Copy row from columns B to end to destination sheet
            ws.Range(Cells(r, 2), Cells(r, lc)).Copy Sheets(sh).Cells(nr, "B")
'           Delete row on source sheet
            ws.Rows(r).Delete
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

Then, in the same procedure, we want to set up a procedure for each different tab we want to move to:
Here are the first two (the rest follow the same structure):

Sub MoveToRescind()
    Call MoveData("Rescind")
End Sub

Sub MoveToNext()
    Call MoveData("Next")
End Sub

Then, all we have to do is assign each button to the appropriate procedure.
So all that buttons that are moving to the "Rescind" sheet can be assigned to the "MoveToRescind" procedure, etc.

 

[LeeLee17]

Genius! I can't wait to try it!!! Thank you- I will let you know how it goes!

 

[Joe4]

You are welcome.
Let me know how it goes, or if we need to make any adjustments.

 

[LeeLee17]

It works brilliantly! It moves the data along the process perfectly! It is so clear that I was able to modify to copy from the initial tab and to the last tab as needed. I can't thank you enough for generously sharing your time and expertise. Thank you for making a difference for our new LO. Best.

 

[Joe4]

You are very welcome.
Glad I was able to help!