Split Data from One Sheet to Different Sheets using VBA

[Haree]

Hello,
I have various sheets in excel approximately 30 to 35 sheets, basically one for each SKU i have a main sheet in which i will enter that days sales or purchase for all the SKU'S they should get posted in their respective sheets. I am attaching a sample sheet, Kindly guide me on how to do the same.
Thanks in advance

New Stock Try.xlsx

drive.google.com

 

[My Aswer Is This]

Try this:

Sub Copy_Rows()
'Modified 3/14/2020 5:39:09 AM EST
Application.ScreenUpdating = False
Sheets("Data Sheet").Activate
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Data Sheet").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
For i = 2 To Lastrow
Lastrowa = Sheets(Cells(i, 1).Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(i, 2).Resize(, 40).Copy Sheets(Cells(i, 1).Value).Rows(Lastrowa)
Next
Application.ScreenUpdating = True
End Sub

This will copy cells in column B to column 40
If this is not enough change 40 to what you want.
Copying a empty cell is not a problem
So just change 40 to what ever you believe will be the most columns ever needed
Now copying a row that has already been copied needs some thinking.
Like I could have the script put a x in column 45 on each row and if the script sees a x in column 45 it will give you a warning

This x would not be copied over to other sheets.
See if this solves problem 1 and I will get back to you with a solution to second problem

 

[My Aswer Is This]

Try this:
When script runs it puts a X in column 45 of sheet named "Data Sheet"
Next Time you run script if there is a X in column 45 that row will not be copied over

Sub Copy_Rows()
'Modified 3/14/2020 6:07:48 AM EST
Application.ScreenUpdating = False
Sheets("Data Sheet").Activate
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Data Sheet").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
For i = 2 To Lastrow
Lastrowa = Sheets(Cells(i, 1).Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
If Cells(i, 45).Value <> "X" Then
Cells(i, 2).Resize(, 40).Copy Sheets(Cells(i, 1).Value).Rows(Lastrowa)
Cells(i, 45).Value = "X"
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Haree]

The first problem is solved, so grateful to you, saves a lot of time for me. I will try the above code now, Just asking out of doubt, i will be having a macro to clear all the cells in the data sheet, once the script is run so at that time i should be clearing column 45 as well ??

 

[My Aswer Is This]

I can have the row deleted on sheet named Data Sheet after script is run but you never asked for that.
Is that what you want?

So we will be deleting all rows on sheet named Data Sheet correct?
Does this also mean row(1)

 

[My Aswer Is This]

Try this will delete all rows on sheet named "Data Sheet" except for row(1)

Sub Copy_Rows()
'Modified 3/14/2020 6:45:26 AM EST
Application.ScreenUpdating = False
Sheets("Data Sheet").Activate
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Data Sheet").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
For i = 2 To Lastrow
Lastrowa = Sheets(Cells(i, 1).Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(i, 2).Resize(, 40).Copy Sheets(Cells(i, 1).Value).Rows(Lastrowa)
Next
Sheets("Data Sheet").Rows(2).Resize(Lastrow - 1).Delete
Application.ScreenUpdating = True
End Sub

 

[Haree]

Hello, It worked so well Thank You so much. Really appreciate your help.

 

[My Aswer Is This]

Hello, It worked so well Thank You so much. Really appreciate your help.

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

 

[Haree]

Hello
A small Doubt
I am receiving a error
Run Time Error '9"
Subscript out of range
can you help me with this

 

[My Aswer Is This]

Hello
A small Doubt
I am receiving a error
Run Time Error '9"
Subscript out of range
can you help me with this

On March 14 you said it worked perfect but now more then a month later you say it's not working. What has changed to make this not work?

 

[Haree]

No Sir it Worked perfectly alright that's y i said so. Now all of a sudden this popped up that's why asked