Transferring Data from worksheet to tabs based on tab name

smiller1999

New Member
Joined
Mar 23, 2016
Messages
1
Hi Guys,

I am working to create a code that will take a worksheet containing a list of students and their associated test scores, generate a tab for each student and then copy and paste their test scores into that tab. The code that I have now will generate the tabs and copy/paste the headers I need but I run into a wall where the data transfer happens. Can anyone suggest what to add to my code to make this happen?

Code:
[/FONT][/COLOR][COLOR=#000000][FONT=HelveticaNeue]Option Explicit[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]Function SheetExists(sheetName As String)[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]  Dim Sheet As Worksheet[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]    For Each Sheet In Sheets[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]        If Sheet.Name = sheetName Then[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]            SheetExists = True[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]            Exit Function[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]        Else[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]            SheetExists = False[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]        End If[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Next[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]End Function[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]Sub CreateWorkbooks()[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]'March 23 2016[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]   Dim newSheet As Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Dim agentSheet As Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Dim cell As Object[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Dim agentRange As String[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Dim SourceSheet As Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Dim TargetSheet As Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Dim SheetNames As Variant[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Dim i As Long[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Dim LR As Long 'Last Row[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]   ' Define where the data is coming from[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Set agentSheet = Sheets("Grade book")[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   ' Turn off screen updating to increase performance[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Application.ScreenUpdating = False[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   ' Build a string that specifies the cells in column B that contain student names starting from cell B13.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   agentRange = "B13:" & agentSheet.Range("B13").End(xlDown).Address[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   ' If the student name has not yet been entered, this creates a tab for it when it is found[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   For Each cell In agentSheet.Range(agentRange)[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]      If SheetExists(cell.Value) = False Then[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]         ' Add the new student worksheet.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         Sheets.Add After:=Sheets(Sheets.Count)[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]         ' Set newSheet variable to the new student worksheet.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         Set newSheet = ActiveSheet[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]         ' Name the new sheet after the student it references.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         newSheet.Name = cell.Value[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]         ' Copy header data from first rows[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         ' of the master worksheet to the range starting at A1 to A12 in the new sheet.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         agentSheet.Range("A1:A12").EntireRow.Copy newSheet.Range("A1")[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]         ' Copy and paste the column widths to the new sheet.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         agentSheet.Range("A1:A12").EntireRow.Copy[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]         newSheet.Range("A1").PasteSpecial xlPasteColumnWidths[/FONT][/COLOR]


[COLOR=#000000][FONT=HelveticaNeue]      End If[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]       Next cell[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   ' Turn screen updating back on.[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Application.ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    'Put cursor back to visible location[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Sheets("Grade book").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]    Range("A24").Select[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]
[/FONT][/COLOR]

[COLOR=#000000][FONT=HelveticaNeue]   'Turn Filter icons off[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   ActiveSheet.Range("$A$1:$V$260").AutoFilter Field:=2[/FONT][/COLOR]
[COLOR=#000000][FONT=HelveticaNeue]   Selection.AutoFilter[/FONT][/COLOR]


[COLOR=#000000][FONT=HelveticaNeue]End Sub

[End Code]

Some details:  Students only have one row of data each and I would prefer not to build each student's name into the code (for ease of future year's use).

Any direction you can provide would be wonderful![/FONT][/COLOR]
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
In one of your comments in the code, you state that student names begin in B13 and use the End(xlDown) function to capture the names. Based on that, one could logically assume that all entries to the right of each name are where student scores are entered. Since you copied the headers from the master sheet to the individual sheets, one could also assume that the data in the columns of all sheets, on the same line as the student name would be of the same type for all sheets. With these assumptions, you should be able to copy the scoring data over with the following snippet.
Code:
Dim c As Range
With agentSheet
    For Each c In .Range("B13", .Cells(Rows.Count, 2).End(xlUp))
        If c.Value <> "" Then
            .Range(c.Offset(, 1), .Cells(c.Row, Columns.Count).End(xlToLeft)).Copy Sheets(c.Value).Range("C13")
        End If
    Next
End With

You can insert this somewhere after the loop where you set your headers up.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,094
Latest member
teemeren

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top