VBA to create multiple copies of a workbook with different name

[Banti]

Hello team,
I am new to excel using macros.
Currently, I am working on a task where I have to create multiple workbooks for each row of data in master excel sheet. Each workbook has a unique name same as ids mentioned in column A of master excel.
I have already created the code for this. But my requirement is to add my customized workbook every time.
Currently,It takes the default Book from the Microsoft office set up.
Any, answer would be greatly helpful for me.
Thanks

 

[Grasor]

How about a different method?

Sub CreateWorkbooks()


Dim rCell As Range
Dim lLastRow As Long
Dim oNewBook, oMyBook As Object
Dim sName As String


Set oMyBook = ActiveSheet

'You would need to set your students sheet object name to "Students" in the IDE. Same deal as naming a module or form for below line to work as posted. 
'Otherwise address the target sheet how you normally would.

lLastRow = Students.UsedRange.Rows.Count

For Each rCell In Students.Range("A2", Range("A" & lLastRow)) 
    
    If rCell.Value <> "" Then
        sName = rCell.Value
        Set oNewBook = Application.Workbooks.Add

        oMyBook.Range("A1").EntireRow.Copy
        oNewBook.Activate
        ActiveSheet.Range("A1").PasteSpecial
        
        rCell.EntireRow.Copy
        oNewBook.Activate
        ActiveSheet.Range("A2").PasteSpecial
        
        On Error GoTo DuplicateName
        oNewBook.SaveAs sName
        oNewBook.Close
    End If
    
Next rCell


Exit Sub


DuplicateName:


MsgBox "Work for student: " & sName & " could not be saved because a workbook with that name is currently open."
Resume Next
End Sub

 

[Banti]

Hello Grasor,
Thanks for the help. But i am not able to understand this program.
I am a beginner in Excel Macro.

 

[Grasor]

I rewrote it to simplify the sheet selection for you. Just rename .Sheets("Students") to whatever the sheet name is with your master list of students on it.

This code need to be launched from a module in the workbook with the master list of students in it.

Do you know how to open the IDE and paste code? Not sure how much of a beginner you are.

I have placed comments in the code block to describe what is happening for you. I changed the code control a bit for the error to not close the unsaved workbook but instead just move on to the next student.

Just paste this into a module. It will read more easily in the IDE.

Sub CreateWorkbooks()


'Declare (dimension) all variables for this procedure.
Dim rCell As Range   'Represents one or more cells
Dim lLastRow As Long 'Represents the last row in which data has been placed in the document.
Dim oNewBook, oMyBook As Object 'Objects representing the New Workbook for individual student and the master workbook.
Dim sName As String 'Represents the student's name as text


Set oMyBook = ActiveSheet  'Set the oMyBook object to be the Active Sheet


lLastRow = ThisWorkbook.Sheets("Students").UsedRange.Rows.Count 'Assign row number to the last row variable




'This is a "For-Next loop"  This one reads: "For each cell in This Workbooks "Students" sheet
'in range A2 through the last row with data in Column A"  Do stuff, then go to the next cell.
For Each rCell In ThisWorkbook.Sheets("Students").Range("A2", Range("A" & lLastRow))
    
    If rCell.Value <> "" Then  'If the current cell isn't blank do stuff
        sName = rCell.Value    'Assign student's name in current cell to the sName variable
        Set oNewBook = Application.Workbooks.Add  'Create a new workbook and set it to the oNewBook object


        oMyBook.Range("A1").EntireRow.Copy 'Copy the header row for the master list
        oNewBook.Activate  'Make the new book active
        ActiveSheet.Range("A1").PasteSpecial 'Paste the header row to the new book
        
        rCell.EntireRow.Copy 'Copy the student's information from that row
        oNewBook.Activate 'Make the new book active
        ActiveSheet.Range("A2").PasteSpecial 'Paste student's information on line 2 of the new book
        
        On Error GoTo DuplicateName 'If there is an error while saving go to the DuplicateName tag
        oNewBook.SaveAs sName 'Save the new book with the student's name
        oNewBook.Close 'Close the new book
    End If 'Step out of the If statement
    
NextCell: 'NextCell tag
Next rCell 'Go to the next student (cell)


Exit Sub 'Leave routine after all students are done with before reaching the DuplicateName tag.


DuplicateName: 'DuplicateName tag


'Create message box letting user know that the save operation couldn't complete.
MsgBox "Work for student: " & sName & " could not be saved because a workbook with that name is currently open."
GoTo NextCell 'Leave unsaved workbook open and go to NextCell tag


End Sub

 

[Banti]

I rewrote it to simplify the sheet selection for you. Just rename .Sheets("Students") to whatever the sheet name is with your master list of students on it. This code need to be launched from a module in the workbook with the master list of students in it. Do you know how to open the IDE and paste code? Not sure how much of a beginner you are.I have placed comments in the code block to describe what is happening for you. I changed the code control a bit for the error to not close the unsaved workbook but instead just move on to the next student.Just paste this into a module. It will read more easily in the IDE.

Sub CreateWorkbooks()'Declare (dimension) all variables for this procedure.Dim rCell As Range   'Represents one or more cellsDim lLastRow As Long 'Represents the last row in which data has been placed in the document.Dim oNewBook, oMyBook As Object 'Objects representing the New Workbook for individual student and the master workbook.Dim sName As String 'Represents the student's name as textSet oMyBook = ActiveSheet  'Set the oMyBook object to be the Active SheetlLastRow = ThisWorkbook.Sheets("Students").UsedRange.Rows.Count 'Assign row number to the last row variable'This is a "For-Next loop"  This one reads: "For each cell in This Workbooks "Students" sheet'in range A2 through the last row with data in Column A"  Do stuff, then go to the next cell.For Each rCell In ThisWorkbook.Sheets("Students").Range("A2", Range("A" & lLastRow))        If rCell.Value <> "" Then  'If the current cell isn't blank do stuff        sName = rCell.Value    'Assign student's name in current cell to the sName variable        Set oNewBook = Application.Workbooks.Add  'Create a new workbook and set it to the oNewBook object        oMyBook.Range("A1").EntireRow.Copy 'Copy the header row for the master list        oNewBook.Activate  'Make the new book active        ActiveSheet.Range("A1").PasteSpecial 'Paste the header row to the new book                rCell.EntireRow.Copy 'Copy the student's information from that row        oNewBook.Activate 'Make the new book active        ActiveSheet.Range("A2").PasteSpecial 'Paste student's information on line 2 of the new book                On Error GoTo DuplicateName 'If there is an error while saving go to the DuplicateName tag        oNewBook.SaveAs sName 'Save the new book with the student's name        oNewBook.Close 'Close the new book    End If 'Step out of the If statement    NextCell: 'NextCell tagNext rCell 'Go to the next student (cell)Exit Sub 'Leave routine after all students are done with before reaching the DuplicateName tag.DuplicateName: 'DuplicateName tag'Create message box letting user know that the save operation couldn't complete.MsgBox "Work for student: " & sName & " could not be saved because a workbook with that name is currently open."GoTo NextCell 'Leave unsaved workbook open and go to NextCell tagEnd Sub

Hello Grasor,As i run this code, It gives me Subscript out of range error. Also i want to use my customised template for each student with data being transposed from rows in master excel to columns in each individual sheet.