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

 

[Fishboy]

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

Hi Banti, welcome to the boards.

I am afraid you will probably need to be a bit more specific as although this should (in theory at least) be fairly simple to achieve it will really boil down to exactly how you envision this working.

So, to clarify...

- Is your master excel sheet the customized workbook you mention, or is that a totally separate document?
- Each cell in column A has an ID. Do you want a copy of the main workbook saved as each separate ID from column A?

 

[Banti]

I have created a template workbook which I want to use for each individual student data.
Problem Statement:
Master excel sheet is having collection of data for 50 students.. e.g. for each student....(name, age, country, weight, etc)
I have to create a macro which will copy data for a student(each row) from master and create a new workbook for each student(unique name for each workbook).

 

[Banti]

Sub Button1_Click()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error GoTo PROC_ERROR

Dim ThisWorkbook As Workbook, NewBook As Workbook
Dim ThisWorksheet As Worksheet, NewWs As Worksheet
Dim i As Integer, j As Integer, k As Integer, ExportCount As Integer

Set ThisWorkbook = ActiveWorkbook
Set ThisWorksheet = ThisWorkbook.Sheets("Sheet1")
ExportCount = 0

For i = 1 To 2
If ThisWorksheet.Cells(i, 1) <> "" Then
Set NewBook = Workbooks.Add
Set NewWs = NewBook.Sheets("Sheet1")
For j = 2 To 12
If ThisWorksheet.Cells(i, j) <> "" Then
NewWs.Cells(j - 1, 1) = ThisWorksheet.Cells(i, j)
End If
Next j
For k = 13 To 23
If ThisWorksheet.Cells(i, k) <> "" Then
NewWs.Cells(k - 12, 2) = ThisWorksheet.Cells(i, k)
End If
Next k
With NewBook
.Sheets("Sheet2").Delete
.Sheets("Sheet3").Delete
.Title = ThisWorksheet.Cells(i, 1)
.SaveAs Filename:=ThisWorksheet.Cells(i, 1) & ".xlsx"
End With
ExportCount = ExportCount + 1
End If
Next i

PROC_ERROR:
If Err.Number <> 0 Then
MsgBox "This macro has encountered an error and needs to exit. However, some or all of your exported workbooks may still have been saved. Please try again." _
& vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbInformation
ExportCount = 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
Else
MsgBox "Successfully exported " & ExportCount & " workbooks!", vbInformation
ExportCount = 0
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

this is my code, 1. which takes data from master, 2. convert data in rows to data in columns 3. copies to new workbook. 4. then saves it with value stored in column A.

My problem : I want to use my template workbook for saving the data instead of (Workbooks. Add)

 

[Fishboy]

In theory you should just be able to amend this line:

Set NewBook = Workbooks.Add

To this:

Set NewBook = Workbooks.Open("C:\TestFolder\Test.xlsx")

But obviously amending the filepath and filename as required.

 

[Banti]

Thanks for the help.
But..i already tried giving file path. It doesn't work creating multiple workbooks.

 

[Banti]

Error 9
Subscript out of the range. Is Shown

 

[Fishboy]

Error 9
Subscript out of the range. Is Shown

Try some different code entirely:

Sub SplitUserDate()
Dim Cell As Range, cRange As Range
Dim Wbk1 As Workbook, Wbk2 As Workbook
Dim UserID As String
    Set Wbk1 = ThisWorkbook
        LRsource = Wbk1.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
            LCsource = Wbk1.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
                Set cRange = Wbk1.Sheets(1).Range("A1:A" & LRsource)
                
For Each Cell In cRange
    UserID = Cell.Value
        Set Wbk2 = Workbooks.Open("C:\TestFolder\Template.xlsx")
            Wbk1.Sheets(1).Activate
                Range(Cell, Cells(Cell.Row, LCsource)).Copy
                    Wbk2.Activate
                        Sheets(1).Range("A2").Select
                            ActiveSheet.Paste
                                Wbk2.SaveAs "C:\TestFolder\" & UserID & ".xlsx"
                                    Wbk2.Close
                                        Application.CutCopyMode = False
Next Cell
End Sub

I have highlighted in bold red the parts that you will need to amend with your own details

 

[Banti]

Wow this macro works great... only one thing it does not do i.e. transpose the row data from master file to columns in the new workbook.
All else, is the exact solution which i was looking for...
Thanks for the valuable help..Fish Boy...
Any learning tips/tutorials for me if u can provide, as i m just a beginner is this field.

 

[Banti]

I tried to transpose the data from rows to column ...but m not getting it.(For the code given by Fishboy)
Can anybody help me to do so.
Thanks.