Move Rows based on Cell Value

[VbaHell]

Hello all

I am hoping someone can help on this

I have a workbook with 13 worksheets, each sheet is named as the 12 months, IE Jan, Feb, Mar Etc and the last sheet is named as data
I am looking for some vba code that when run will look at the cell value in column "S" and move each row to the correct worksheet based on the worksheet name.

IE: S6 = Mar, copy row to the next available row in worksheet "Mar"

Is this possible please

 

[My Aswer Is This]

Try this:
Assuming your sheet is named "data"
The script starts in row(2) and looks in column (S) for sheet name.
Make sure all values in column (S) are exactly the same as sheet name.

Sub Test()
Application.ScreenUpdating = False
'Modified 3-21-18 5:25 PM EDT
On Error GoTo M
Dim i As Long
Sheets("data").Activate
Dim Lastrow As Long
Lastrow = Sheets("data").Cells(Rows.Count, "S").End(xlUp).Row
    For i = 2 To Lastrow
            Rows(i).Copy Sheets(Cells(i, "S").Value).Rows(Sheets(Cells(i, "S").Value).Cells(Rows.Count, "S").End(xlUp).Row + 1)
    Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "That sheet name does not exist or you had some other sort of problem"
Application.ScreenUpdating = True
End Sub

 

[VbaHell]

Works like a dream

Thanks very much for your support on this

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Works like a dream

Thanks very much for your support on this

 

[VbaHell]

I hope am not being a pain here but is it possible to change the code to work this way please

Instead of copying the whole Row copy a range from "A2:S2" and loop through all Rows

Then copy the range "A2:S2" as before to each worksheet but place "A2:S2" starting in cell "E2"

 

[My Aswer Is This]

Not sure. Your request has now changed.

 

[My Aswer Is This]

Try this:

Sub Test()
Application.ScreenUpdating = False
'Modified 3-22-18 11:55 PM EDT
On Error GoTo M
Dim i As Long
Dim ans As Long
Sheets("data").Activate
Dim Lastrow As Long
Lastrow = Sheets("data").Cells(Rows.Count, "S").End(xlUp).Row
    For i = 2 To Lastrow
        Cells(i, 1).Resize(, 19).Copy Sheets(Cells(i, "S").Value).Cells(Sheets(Cells(i, "S").Value).Cells(Rows.Count, "S").End(xlUp).Row + 1, "E")
     Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "That sheet name does not exist or you had some other sort of problem"
Application.ScreenUpdating = True
End Sub

 

[VbaHell]

Yes, this is great, dead chuffed

Thank you very much

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Yes, this is great, dead chuffed

Thank you very much