COPY DATA TO MANY WORKSHEETS FROM MASTER SHEET

[BABU Baru]

I need your help to solve my problem. I am learning.

Data in sheet named “Master Sheet” from Column A2:F2 and rows can be many. The header is in Row “A1. The name of students are in Column “A2:A”. I have already created sheets for each students by student name in same workbook.

I want to copy data to appropriate sheet of the student as soon as I enter data and hit “ENTER” key.

A B C D E F

1	STUDENT NAME	MATHS	ENGLISH	PHYSICS	CHEMISTRY	BIOLOGY
2
3

 

[Logit]

Sub CopyOwnTab()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error GoTo M
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Dim ans As String
    For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
        Sheets("Master").Rows(i).Resize(, 6).Copy Sheets(ans).Rows(Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1)
        
    Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "No such sheet as  " & ans & " exist"
Application.ScreenUpdating = True
End Sub

 

[vcoolio]

Hello Babubaru,

Here's another option which should work well should your data set be extensive:-

Sub TestBabu()

        Dim wsM As Worksheet, ar As Variant, lr As Long, i As Long
        Set wsM = Sheets("Master")
        lr = wsM.Range("A" & Rows.Count).End(xlUp).Row
        
        wsM.Range("A1:A" & lr).AdvancedFilter 2, , wsM.[Z1], 1
        wsM.Range("Z2", wsM.Range("Z" & wsM.Rows.Count).End(xlUp)).Sort [Z2], 1
        ar = wsM.Range("Z2", wsM.Range("Z" & wsM.Rows.Count).End(xlUp))


Application.ScreenUpdating = False
        
        For i = 1 To UBound(ar)
                Sheets(ar(i, 1)).UsedRange.Clear
                With wsM.[A1].CurrentRegion
                        .AutoFilter 1, ar(i, 1)
                        .Copy Sheets(ar(i, 1)).[A1]
                        .AutoFilter
                End With
        Next i

wsM.Columns("Z").Clear
Application.ScreenUpdating = True

End Sub

The code extracts the unique name values in Column A and temporarily places them into Column Z and are then sorted. These unique values are then placed into an array which is then used to filter on and copy/paste to the relevant work sheets.
Please test the code in a copy of your actual workbook.

I hope that this helps.

Cheerio,
vcoolio.

 

[BABU Baru]

Sub CopyOwnTab()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error GoTo M
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Dim ans As String
    For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
        Sheets("Master").Rows(i).Resize(, 6).Copy Sheets(ans).Rows(Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1)
       
    Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "No such sheet as  " & ans & " exist"
Application.ScreenUpdating = True
End Sub

Sorry, I didn't work.

 

[BABU Baru]

Hello Babubaru,

Here's another option which should work well should your data set be extensive:-

Sub TestBabu()

        Dim wsM As Worksheet, ar As Variant, lr As Long, i As Long
        Set wsM = Sheets("Master")
        lr = wsM.Range("A" & Rows.Count).End(xlUp).Row
       
        wsM.Range("A1:A" & lr).AdvancedFilter 2, , wsM.[Z1], 1
        wsM.Range("Z2", wsM.Range("Z" & wsM.Rows.Count).End(xlUp)).Sort [Z2], 1
        ar = wsM.Range("Z2", wsM.Range("Z" & wsM.Rows.Count).End(xlUp))


Application.ScreenUpdating = False
       
        For i = 1 To UBound(ar)
                Sheets(ar(i, 1)).UsedRange.Clear
                With wsM.[A1].CurrentRegion
                        .AutoFilter 1, ar(i, 1)
                        .Copy Sheets(ar(i, 1)).[A1]
                        .AutoFilter
                End With
        Next i

wsM.Columns("Z").Clear
Application.ScreenUpdating = True

End Sub

The code extracts the unique name values in Column A and temporarily places them into Column Z and are then sorted. These unique values are then placed into an array which is then used to filter on and copy/paste to the relevant work sheets.
Please test the code in a copy of your actual workbook.

I hope that this helps.

Cheerio,
vcoolio.

This VBA code is not working

 

[Logit]

Provide a sample of your workbook. This Forum does not provide a means of posting a workbook. You will need to upload it to a CLOUD website
for download and provide the link in your next post.

Thanks.