Moving rows to different sheets based on drop down.

[purevega]

Hello! Thank you in advance for visiting my post. I understand there have been a couple posts here already that ask for help regarding VBA code and moving data from one sheet to another based on a drop-down value, I appreciate your help nonetheless.

----------

We are approaching territory changes for our sales team, and the current process takes 4-5 months to complete which we are looking to cut down significantly. I believe we can achieve a more efficient process by introducing VBA code into our excel sheets and moving rows of data from one sheet to another (or from account manager to account manager). I've watch a beginner's tutorial on VBA code (and macros) which has been helpful but I believe what I'm trying to achieve is more advanced than my current knowledge and I'm willing to learn.

Below is a screenshot of an example sheet that includes the basic information we use for territory changes (although missing rollup totals of their entire portfolio), where we would move the respective rows to the individual selected in the drop down menu in column "E" to the end of the data of the respective person receiving the new account (see highlighted row in the second screenshot). Each sheet titled "Person X" has the same layout you see below as well.

Screenshot 1

Screenshot 2

I'm looking for help creating VBA code that would CUT/PASTE a row of data from one sheet to another that would eventually contribute to a roll-up total of column C somewhere on the sheet (could be the top or bottom, doesn't matter). Although I provided the basic information we use for territory changes, there may be some additional rows to be included to help with decision making - so a helpful note in the code where I can extend the selection of rows being cut/paste would be nice.


I'm extremely thankful for any help regarding this, and I'm looking forward to learning how VBA code works further and adding it to my arsenal of skills

 

[purevega]

Here is what we used last year and will use this year, column B will be used as the drop down containing sales team initials.

Apologies, I can't use the xl2bb due to work computer restrictions. Let me know how else I can help.

 

[Cubist]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim selectedName As String
    Dim currentRow As Long
    Dim lastCell As Range
 
    If Not Intersect(Target, Me.Columns("B")) Is Nothing Then
        If Target.Cells.Count = 1 Then
            selectedName = Target.Value
         
            On Error Resume Next
            Set ws = ThisWorkbook.Sheets(selectedName)
            On Error GoTo 0
         
            If Not ws Is Nothing Then
                Application.EnableEvents = False
             
                currentRow = Target.Row
                Set lastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
                                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
                If Not lastCell Is Nothing Then
                    lastRow = lastCell.Row + 1
                Else
                    lastRow = 1
                End If
             
                ws.Range("A" & lastRow) = Me.Range("A" & currentRow & ":J" & currentRow)
                Me.Rows(currentRow).Delete
                Application.EnableEvents = True
            Else
                MsgBox "Sheet named '" & selectedName & "' does not exist.", vbExclamation
            End If
        End If
    End If
End Sub

 

[purevega]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim selectedName As String
    Dim currentRow As Long
    Dim lastCell As Range
 
    If Not Intersect(Target, Me.Columns("B")) Is Nothing Then
        If Target.Cells.Count = 1 Then
            selectedName = Target.Value
        
            On Error Resume Next
            Set ws = ThisWorkbook.Sheets(selectedName)
            On Error GoTo 0
        
            If Not ws Is Nothing Then
                Application.EnableEvents = False
            
                currentRow = Target.Row
                Set lastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
                                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
                If Not lastCell Is Nothing Then
                    lastRow = lastCell.Row + 1
                Else
                    lastRow = 1
                End If
            
                ws.Range("A" & lastRow) = Me.Range("A" & currentRow & ":J" & currentRow)
                Me.Rows(currentRow).Delete
                Application.EnableEvents = True
            Else
                MsgBox "Sheet named '" & selectedName & "' does not exist.", vbExclamation
            End If
        End If
    End If
End Sub

Thanks Cubist, I'll give it a try tomorrow.