Copy Range based on cell value and worksheet name

[VbaHell]

Hello All

I gratefully obtained this code from one of our Mr Excel members but it's not quite working as I would like

It copies a Row range "A:I" and based on the value in "I" then moves this Row range to a worksheet that is named as the cell value and puts the range start in column "J"

At the moment it only copies one row range on each worksheet when it should copy several rows on each worksheet based on the cell value

Can anyone spot my error please

[

Sub Test()
Application.ScreenUpdating = False
On Error GoTo M
Dim r As Long
Dim ans As Long
Sheets("data").Activate
Dim Lastrow As Long
Lastrow = Sheets("data").Cells(Rows.Count, "I").End(xlUp).Row
For i = 2 To Lastrow
Cells(r, 1).Resize(, 9).Copy Sheets(Cells(r, "I").Value).Cells(Sheets(Cells(r, "I").Value).Cells(Rows.Count, "I").End(xlUp).Row + 1, "J")
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]​

 

[Dryver14]

What is r ?

 

[VbaHell]

Hi Dryver

I had you write the code into the message box because for some reason I can't copy paste and miss typed this line, it should read

[For r = 2 To Lastrow

 

[MARK858]

I had you write the code into the message box because for some reason I can't copy paste

I take it you are using Edge as your browser?

 

[Dryver14]

I personally would not try to do everything in one line

I'm not sure this piece of code needs repeating

Cells(r, 1).Resize(, 9).Copy Sheets(Cells(r, "I").Value).Cells(Sheets(Cells(r, "I").Value).Cells(Rows.Count, "J").End(xlUp).Row + 1, "J")

also as you are adding to J you are taking the base row reading from I so I would use J or work out how to move onto J to read the base line as I isnt changing so its copying over itself each time

 

[VbaHell]

That's it now working

Thanks very much

Also changed my browser from Edge and I can copy paste now

Happy Sunday