Automatically move row to sheet based on cell value

[arypple]

I am creating a lead workbook that can flow to other worksheets in the workbook when the status of the lead changes.

I have a dropdown box currently that shows from each worksheet what the status can change to. I have copied and pasted some VBA modules data I found online and it works for one status change but it will not move to appropriate sheet based on different status options.

Column F is a status dropdown which change at each worksheet. Here is the path they can go from each page. They all start at leads. I would like for them to move the entire line automatically when that status changes. Can you help me with the VBA coding?

Lead --> Completed App

Lead --> Lost Lead

Completed App-->Not Qualified

Completed App --> Pre-Qualified

Completed App --> Lost Lead

Pre-Qualified --> Under Contract

Pre-Qualified --> Lost Lead

Under Contract --> Closed

Under Contract --> Lost Lead

 

[Warship]

You may have worked this out already but this was something I'd never done so I gave it a whirl.
Paste into Workbook_SheetChange
Please let me know.

Option Explicit
    Dim strShSource As String
    Dim strShDestin As String
    Dim iNextRow As Integer

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveCell = "" Then Exit Sub
    strShSource = ActiveSheet.Name
    Select Case strShSource
        Case Is = "Lead": UpdateStatus
        Case Is = "Completed App": UpdateStatus
        Case Is = "Pre-Qualified": UpdateStatus
        Case Is = "Under Contract": UpdateStatus
        Case Else: Exit Sub
    End Select
End Sub

Private Sub UpdateStatus()
    Dim Response: Response = MsgBox("Sure?", vbYesNo, "No Undo")
    If Response = vbNo Then
        Application.Undo
        Exit Sub
    End If
On Error GoTo GetOut
    strShDestin = Cells(Rows.Count, 6).End(xlUp)
    iNextRow = Sheets(strShDestin).Cells(Rows.Count, 1).End(xlUp).Row + 1
    Application.EnableEvents = False
        ActiveCell.Offset(, -5).Resize(1, 5).Copy _
            Destination:=Sheets(strShDestin).Cells(iNextRow, 1)
        Application.Goto Reference:=Sheets(strShDestin).Cells(iNextRow, 1), scroll:=True
        SetupDataValidation
        If Cells(iNextRow, 6) = "" Then Cells(iNextRow, 6) = strShDestin
    Application.EnableEvents = True
    Application.CutCopyMode = False
Exit Sub
GetOut:
    Application.EnableEvents = True
    Application.CutCopyMode = False
    MsgBox "Well that went badly!"
End Sub

Sub SetupDataValidation()
    Dim strDVList As String
    strDVList = ""
    Application.Goto Reference:=Sheets(strShDestin).Cells(iNextRow, 1), scroll:=True
    Select Case strShDestin
        Case Is = "Lead"
            strDVList = "Completed App,Lost Lead"
        Case Is = "Completed App"
            strDVList = "Pre-Qualified,Not Qualified,Lost Lead"
        Case Is = "Pre-Qualified"
            strDVList = "Under Contract,Lost Lead"
        Case Is = "Under Contract"
            strDVList = "Closed,Lost Lead"
        Case Else
                Exit Sub
    End Select
    Sheets(strShDestin).Cells(iNextRow, 6).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=strDVList
    End With
End Sub

 

[Warship]

Above code was looping. Made adjustments here.

Option Explicit
    Dim strShSource As String
    Dim strShDestin As String
    Dim iNextRow As Integer

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveCell = "" Then Exit Sub
    strShSource = ActiveSheet.Name
    Select Case strShSource
        Case Is = "Lead": UpdateStatus
        Case Is = "Completed App": UpdateStatus
        Case Is = "Pre-Qualified": UpdateStatus
        Case Is = "Under Contract": UpdateStatus
        Case Else: Exit Sub
    End Select
End Sub

Private Sub UpdateStatus()
    Dim Response: Response = MsgBox("Sure?", vbYesNo, "No Undo")
    With Application
        If Response = vbNo Then
            .EnableEvents = False
            .Undo
            .EnableEvents = True
            Exit Sub
        End If
    End With
On Error GoTo GetOut
    strShDestin = Cells(Rows.Count, 6).End(xlUp)
    iNextRow = Sheets(strShDestin).Cells(Rows.Count, 1).End(xlUp).Row + 1
    Application.EnableEvents = False
        ActiveCell.Offset(, -5).Resize(1, 5).Copy _
            Destination:=Sheets(strShDestin).Cells(iNextRow, 1)
        SetupDataValidation
        If Cells(iNextRow, 6) = "" Then Cells(iNextRow, 6) = strShDestin
    Application.EnableEvents = True
    Application.CutCopyMode = False
Exit Sub
GetOut:
    Application.EnableEvents = True
    Application.CutCopyMode = False
    MsgBox "Well that went badly!"
End Sub

Sub SetupDataValidation()
    Dim strDVList As String
    strDVList = ""
    Application.Goto Reference:=Sheets(strShDestin).Cells(iNextRow, 1), scroll:=True
    Select Case strShDestin
        Case Is = "Lead"
            strDVList = "Completed App,Lost Lead"
        Case Is = "Completed App"
            strDVList = "Pre-Qualified,Not Qualified,Lost Lead"
        Case Is = "Pre-Qualified"
            strDVList = "Under Contract,Lost Lead"
        Case Is = "Under Contract"
            strDVList = "Closed,Lost Lead"
        Case Else
            Exit Sub
    End Select
    Sheets(strShDestin).Cells(iNextRow, 6).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=strDVList
    End With
End Sub