0

I have a workbook with multiple worksheets containing student names and data. Each worksheet has the same names but different data. I need to copy each row and create a new workbook file for each student containing the same number of worksheets for that one student. The new workbook should have the student's name as the filename and the worksheets should have the same tab titles as the source workbook. This requirement is the same as Copy data from workbook with multiple worksheets into multiple new workbooks with only one row on each worksheet but it only has an explanation of how to do it with no code solution.

I have some code obtained online that splits a single worksheet into multiple worksheets per row in the same workbook. How can I modify this so it creates a new workbook for each individual row with the same number of worksheets?

To illustrate, say I have 32 students with grade data in a workbook. The workbook contains 10 worksheets representing different assignment categories (summative 1, summative 2, formative 1, formative 2...etc). I need to create 32 workbooks, one for each student with 10 worksheets each. I've attached the code that needs modifying below:

Sub SplitRowsToWorksheets()
Dim ColHead As String
Dim ColH As Range
Dim iCol As Integer
Dim iRow As Long 'row index
Dim Lrow As Integer 'row index on individual destination sheet
Dim wsDest As Worksheet 'destination worksheet
Dim wsActive As Worksheet 'active worksheet

TryAgain:
    ColHead = InputBox("Enter Column Heading", "Identify Column", [A1].Value)
        If ColHead = "" Then Exit Sub
        Set ColHeadCell = Rows(1).Find(ColHead, LookAt:=xlWhole)
        If ColHeadCell Is Nothing Then
            MsgBox "Heading not found in row 1"
            GoTo TryAgain
        End If
    'RowHead = InputBox("Enter the first row of data after the header")
Set wsActive = activeSheet
iCol = ColHeadCell.Column
'loop through values in selected column
For iRow = 2 To wsActive.Cells(65536, iCol).End(xlUp).Row
    If Not SheetExists(CStr(wsActive.Cells(iRow, iCol).Value)) Then
        Set wsDest = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        Set range_for_pasting1 = wsDest.Rows("1:1")
        'Set range_for_pasting2 = wsDest.Rows(2)
        Set range_to_copy1 = wsActive.Rows("1:1")
        'Set range_to_copy2 = wsActive.Rows(2)
        wsDest.Name = CStr(wsActive.Cells(iRow, iCol).Value)
        'Copy and paste the first header row
        range_to_copy1.copy
        range_for_pasting1.PasteSpecial (xlPasteAll)
        range_for_pasting1.PasteSpecial (xlPasteColumnWidths)
       'Copy and paste the second header row
        'range_to_copy2.Copy
        'range_for_pasting2.PasteSpecial (xlPasteAll)
        'range_for_pasting2.PasteSpecial (xlPasteColumnWidths)
    Else
        Set wsDest = Worksheets(CStr(wsActive.Cells(iRow, iCol).Value))
    End If
Lrow = wsDest.Cells(65536, iCol).End(xlUp).Row
wsActive.Rows(iRow).copy
Set range_for_pasting3 = wsDest.Rows(Lrow + 1)
range_for_pasting3.PasteSpecial (xlPasteAll)
Application.CutCopyMode = False

Next iRow
End Sub


Function SheetExists(SheetId As Variant) As Boolean
'Checks to see if the sheet exists
Dim sh As Object
On Error GoTo NoSuch
Set sh = Sheets(SheetId)
SheetExists = True
Exit Function
NoSuch:
If Err = 9 Then SheetExists = False Else Stop
End Function

Thanks

brohjoe
  • 854
  • 4
  • 17
  • 39
  • "to create 32 workbooks for each student" ? I think you mean 32 workbooks, one for each student, correct ? – CDP1802 Apr 03 '21 at 18:10
  • I think best approach here is having a workbook with macros to copy the file 32 times, and then open each workbook and delete the rows you don't want. Copying the workbook 32 times will assure you have the same data estructure and the 10 worksheets you need. You just need to loop 32 times and keep rows relative to student A, B, C...and so on in each loop – Foxfire And Burns And Burns Apr 03 '21 at 18:50
  • I would use AdvancedFilter in a loop to select the data for each student and copy it to a new worksheet. You can them use Worksheet.Move to copy the worksheet to a new workbook. – Nicholas Hunter Apr 03 '21 at 20:35
  • Yes, 32 workbooks, one for each student. I've edited the question. – brohjoe Apr 04 '21 at 17:36

0 Answers0