VBA help required: Creating multiple workbooks from a template and a list of names

[CarolynL]

Hopefully someone smarter than me can provide me with a neat VBA macro that will do the following;

The easiest way I can describe the scenario I am trying to create, is to use a company list of personnel (my index) and to generate a time-sheet workbook per person based on a pre-populated template. This time-sheet is saved as the persons name and has the persons name entered into cell D:10

I have a workbook which contains two worksheets;
1) An Index sheet which contains a list of names that I wish to use in Q16 downwards (note the length of this list will vary each time I run this)
2) A "template" sheet which I wish to duplicate in new workbooks
3) A second "data" sheet that I wish to copy across in new workbooks


I need a macro that will take the "template" and "data" sheets and copy it into a new workbook, renaming each new workbook to each name in my Index sheet. I also want that same Name to be copied into cell reference D:10 of the "template" each time.

The end result is that I should have a series of new files generated and saved which are named the same as the Index list, with both the "Template" sheet and the "Data" sheet present, with the cell D:10 pre-populated with the Name provided in the "Template" sheet.

For ease, I'll save these into My Documents for now. (If you need that info?)

I'm using Excel 2010, and have some knowledge of macros through using these forums for help, however I'm still a newbie so this one is making my head spin!

I hope that makes sense.

 

[edodotcom]

Hi,

I'm having the same problem here. And, thank you for your guidance.
Just 1 more question:
If I'm using a formula on my original sheet... when I ran this macro, the cells w/ formulas on the new workbooks are still linked to external references (my original workbook).

In this case, for example:
in my original workbook ("master.xlsm"), sheet "Data" at cell D11, I used this formula:
=D10&" FIRED"


When I run the macro.
in new workbook, the sheet "Data" at cell D11, I found its formula still:
='[master.xlsm]Data'!D10&" FIRED"


QUESTION:
Do you know how to remove that external link? Thus, I will have different value of D11 on every single new workbook.

Really appreciate your help on this matter.. Thank you so much.


Best Regards,
Edward

Try it this way.

Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "Q").End(xlUp).Row
Set rng = sh1.Range("Q16:Q" & lr)
    For Each c In rng
        Sheets("Template").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("D10") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub

 

[kimshine]

I have read above posting and I need your help to similar requirements as below mentioned.
I will need to create a multiple spreadsheets (using my list called "List" and pre-populate spreadsheet template called "Template") and each worksheet should populate the values from the "List" and save different worksheet names.

1. Here is a list format "List" with four columns as below
Cde Curr Sales Worksheet Name
SnTP USD 100.01 A-test
ABC CAD 10000.01 B-test
EDF USD 75000.01 C-Test
2. The template "template" format looks like this below and I will need to populate the "Cde", "currency", and "Sales" fields and it has only one row to populate per each spreadsheet.
Then this spreadsheet should be saved as "A-Test.xlsx"
Policy Name Code Cde Currency Action Date Sales
ABV Super Blank SnTP USD None 12/31 100.01

Is it make sense?
Can you please help?


I need to use data from the "List" and populate multiple spreadsheets with

 

[Adambe]

This works really well

Try it this way.

Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "Q").End(xlUp).Row
Set rng = sh1.Range("Q16:Q" & lr)
    For Each c In rng
        Sheets("Template").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("D10") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub

However I need to modify the code to populate 2 cells in the sheet called template. A1 from Data to populate B3 in template and B1 in Data to populate B4 in template, then it should save the newly populated template with the c.value from cell B3. What I've tried (see below) populates the data from A2 in Data to both B3 and B4 in the template and saves the file with the c.value for B4.

Sheet 1: Contains data in Column A and B
Sheet 2: Template
Sheet 3: Misc info needed to be copied to the new workbook with populated data
Sheet 4: Misc info needed to be copied to the new workbook with populated data
Sheet 5: Misc info needed to be copied to the new workbook with populated data

What I've tried:

Sub create()Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Data") 'Edit sheet name
Set sh2 = Sheets("Template") 'Edit sheet name
Set sh3 = Sheets("3") 'Edit sheet name
Set sh4 = Sheets("4") 'Edit sheet name
Set sh5 = Sheets("5") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "a").End(xlUp).Row
Set rng = sh1.Range("A2:A2" & lr)
Set rng = sh1.Range("B2:B2" & lr)
    For Each c In rng
        Sheets("Template").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("B3") = c.Value
         wb.Sheets(1).Range("B4") = c.Value
        sh3.Copy After:=wb.Sheets(1)
        sh4.Copy After:=wb.Sheets(2)
        sh5.Copy After:=wb.Sheets(3)
        
        wb.SaveAs "Solution_" & c.Value & ".xlsx"
        wb.Close False
    Next
End Sub

 

[lejack02]

Try it this way.

Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "Q").End(xlUp).Row
Set rng = sh1.Range("Q16:Q" & lr)
    For Each c In rng
        Sheets("Template").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("D10") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub

Hello!

Hopefully somebody will be able to help me even though this thread is 3 years old

I face the same situation as CarolynL with slight differences.

- My list of names starts on cell B1 and not Q16
- The cell where I have to copy the data in the template is C12 and not D10.

I have done the changes in the code ahnd I have this :

Sub create()Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range


Set sh1 = Sheets("Index")
Set sh2 = Sheets("Data")


lr = sh1.Cells(Rows.Count, "B").End(xlUp).Row


Set rng = sh1.Range("B6:B" & lr)


    For Each c In rng
        Sheets("Template").Copy
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("C12") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
    
End Sub

It works well for the first line (B6) and create the template properly but then, it doesn't work anymore. VBA gives me the error :
"Run time error "1004" - Application- defined or object-defined error.

Could you please help me ?

Thanks,
Jack

 

[unklevig]

Try it this way.

Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "Q").End(xlUp).Row
Set rng = sh1.Range("Q16:Q" & lr)
    For Each c In rng
        Sheets("Template").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("D10") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub

This works great for what I'm trying to do, but can the new workbooks be saved to the same directory/folder as the original workbook? I've tried searching for this solution, and tried modifying/combining other codes, but no luck since it is creating multiple workbooks. I've tried to modify the following line but with no luck:
"wb.SaveAs c.Value & ".xlsx"
Any solutions would be appreciated! Thank you.

 

[RoryA]

If you want them in the same folder as the code workbook, use:

wb.SaveAs thisworkbook.path & application.pathseparator & c.Value & ".xlsx"

 

[unklevig]

Thanks for the quick response! I tried your above code in place of the "wb.SaveAs c.Value & ".xlsx" but I'm getting a VBA Run-Time error
438': Object doesn't support this property or method. I double checked everything and it creates the workbook with the two new sheets I'm copying, but that is when the error pops up and it won't save. Could it have something to do with the "wb.Sheets(1).Range("A1") = C.Value"? I noticed the new workbook doesn't have a "Sheets(1)" it starts with "Sheets(2)" which I'm assuming is coming from the original workbook. Thanks again.

 

[RoryA]

Every workbook has to have sheets(1).

 

[unklevig]

Every workbook has to have sheets(1).

I tried a brand new workbook and I think I misread the not having a "Sheet1"in the VBA module. I'm still getting the same error though. Thanks again for your time.

 

[RoryA]

Please copy and paste the exact code you have now that causes the 438 error.