VBA code to move entire rows from one sheet to 3 different sheets based on cell values from dropdown list

[Alminc]

Hello,

I am trying to use VBA code in order to move entire rows from sheet1 named "New Projects" to 3 different sheets, based on cell value picked from in-cell dropdown list in sheet1.

I am not a coder but I could understand a little and fond a piece of code somewhere on the internet.

So far I found the code that can move a row from my sheet1 ("New Projects") to other sheet named "Prio1", if the cell value picked from dropdown list becomes "Prio 1" (meaning that I am moving that new project (entire row) to sheet "Prio1" because it has priority number 1.

But I have even the sheets named Prio2 and Prio3 where I need to move the rows when the value in the cell is "Prio 2" or "Prio 3", and I dont know how to do it.

If I just copy/paste same code in the editor and only change sheet names then I get some error message "Ambiguous name Worksheet_Change" and it doesn't work.


This is the piece of code that I found and it works for moving rows to Prio1:

Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Dim answer As Integer
    
        Dim lngRow As Long, ws As Worksheet, nextrow As Long
            
        If Target.Cells.Count > 1 Then Exit Sub
        
        Application.ScreenUpdating = False
        
        If Not Intersect(Target, Columns("M:M")) Is Nothing Then
            If Target.Value = "Prio 1" Then
                lngRow = Target.Row
                On Error Resume Next
                With ThisWorkbook
                    Set ws = Worksheets("Prio1")
                    If ws Is Nothing Then .Worksheets.Add().Name = "Prio1"
                    nextrow = Worksheets("Prio1").Cells(Rows.Count, "A").End(xlUp).Row + 1
                End With
                With Sheet1 'code name
                    answer = MsgBox("Move this project to Prio1?", vbYesNo + vbQuestion)
                If answer = vbYes Then
                    .Range("A" & lngRow).EntireRow.Copy Destination:=Worksheets("Prio1").Range("A" & nextrow)
                    .Range("A" & lngRow).EntireRow.Delete shift:=xlUp
                Else
                     Worksheets("New Projects").Range("M:M").ClearContents 
                     
                End If
                
                End With
            End If
        End If
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        Set ws = Nothing
        
    End Sub

Now I need help to add equivalent code for "Prio2" anf "Prio3" to the code above.

Can someone please help me out?


Almin

 

[My Aswer Is This]

Try this:
This script will add any new sheet if it does not exist without having to evaluate if certain sheets exist.

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 3-31-18 5:10 PM EDT
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Columns("M:M")) Is Nothing Then Exit Sub
Dim ans As Long
Dim sh As String
sh = Target.Value
Dim Lastrow As Long
On Error GoTo M
ans = Target.Row
Lastrow = Sheets(sh).Cells(Rows.Count, "M").End(xlUp).Row + 1
Rows(ans).Copy Sheets(sh).Rows(Lastrow)
Exit Sub
M:
ss = MsgBox("You have no sheet named  " & Target.Value & "  Do you want to add this new sheet?", vbYesNo)
If ss = vbYes Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sh
Lastrow = Sheets(sh).Cells(Rows.Count, "M").End(xlUp).Row + 1
Rows(ans).Copy Sheets(sh).Rows(Lastrow)
End If
End Sub