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
[
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]
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]