# 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.


----------



## JLGWhiz

All sheet names should be edited for accuracy.  See if this will work.



		Code:
__


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 = sh.Cells(Rows.Count, "Q").End(xlUp).Row
Set rng = sh.Range("Q16:Q" & lr)
    For Each c In rng
        Set wb = Sheets("Template").Copy 'Edit sheet name
        wb.Sheets(1).Range("D10") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub


----------



## CarolynL

It looks like it might work, however its bugging at this point and I'm not sure why?  Says object required;



		Code:
__


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
[U][B]        Set wb = Sheets("Template").Copy 'Edit sheet name[/B][/U]
        wb.Sheets(1).Range("D10") = c.Value
        sh2.Copy After:=wb.Sheets(1)
        wb.SaveAs c.Value & ".xlsx"
        wb.Close False
    Next
End Sub


Thanks,
Carolyn


----------



## sheetspread

If the sheet you call "Template" has a different name be sure it matches what's on that line.


----------



## CarolynL

sheetspread said:


> If the sheet you call "Template" has a different name be sure it matches what's on that line.



All the sheet names are correct in the macro - it still doesn't seem to be working


----------



## JLGWhiz

Try it this way.


		Code:
__


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


----------



## CarolynL

JLGWhiz said:


> Try it this way.



That worked fantastically.  Thank-you very much!


----------



## JLGWhiz

CarolynL said:


> That worked fantastically. Thank-you very much!



You're welcome
Regards, JLG


----------



## PATTANAM

Hello All,    
I have red above posting and I require your help to similar requirement as below mentioned.  

I have mentioned like many company codes and one workbook is created (xyz) with full of details as requirement. 

My requirement is that which is already created (xyz) with full of details same files/workbooks to be created (new/Save As) as much as I have given company codes but here company code may be varies. 

Criteria-1 : While creating files each file name should each company code (one by one).

Criteria-2 : Once it creates files with each company code same company code details should be updated in Range ("A15") in each file company code workbooks.

Company Code
GR00
HU00
IE00
IL10
IT40


----------



## sheetspread

If the company codes are in A2:A6 of the tab named "Data", this will create new workbooks with them as the filename and cell A15 value:



		Code:
__


Sub wkbksfromlist()
Dim x%, lr%
Dim wbname As String
Dim wbnew As Workbook
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lr
wbname = ThisWorkbook.Sheets("Data").Range("A" & x).Value
Set wbnew = Workbooks.Add()
wbnew.SaveAs Filename:="C:\Users\myname\Desktop\" & wbname & ".xlsx"
With ActiveWorkbook
.Sheets("sheet1").Range("A15").Value = wbname
.Close SaveChanges:=True
End With
Next
End Sub


----------



## 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




JLGWhiz said:


> Try it this way.
> 
> 
> Code:
> __
> 
> 
> 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



JLGWhiz said:


> Try it this way.
> 
> 
> Code:
> __
> 
> 
> 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:



		Code:
__


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

JLGWhiz said:


> Try it this way.
> 
> 
> Code:
> __
> 
> 
> 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 : 



		Code:
__


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

JLGWhiz said:


> Try it this way.
> 
> 
> Code:
> __
> 
> 
> 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:



		Code:
__


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

RoryA said:


> 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.


----------



## 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.


----------



## unklevig

Sub create ()
'From JLGWhiz on MrExcel
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("CAB")
Set sh2 = Sheets ("CAV")
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A5:A" & lr)
   For Each C In rng
       Sheets("CAL").Copy
       Set wb = ActiveWorkbook
       wb.Sheets(1).Range("A1") = C.Value
       sh2.Copy After:=wb.Sheets(1)
       'wb.SaveAs C.Value & ".xlsx"     'Note when I use this code it works fine, but it saves the new workbooks to "Documents"
       wb.SaveAs ThisWorkbook.Path & Application.pathseperator & C.Value & ".xlsx" 'Note when I use this code I get the error
       wb.Close False
   Next
End Sub

Appreciate it!


----------



## RoryA

You should have just copied my code. It's pathsep*a*rator, not pathseperator.


----------



## unklevig

RoryA said:


> You should have just copied my code. It's pathsep*a*rator, not pathseperator.


You my friend are a genius, seems to work like a charm! I was trying to do some learning and typing as the codes popup in the VBA module, I still fat-fingered it somehow.


----------



## RoryA

Glad to help.


----------



## JLGWhiz

This also works"


		VBA Code:
__


wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx"


and eliminates the spelling problem.


----------



## RoryA

As long as you aren't on a Mac.


----------



## JLGWhiz

The only thing I ever liked about a MAC was the graphics, and that comparison was made back in the 1990s, so it may not even hold true anymore.  But we all have our preferences and mine is PC.


----------



## RoryA

So is mine as far as Excel is concerned, but I don't always have control over my target audience!


----------



## JLGWhiz

{Quote]but I don't always have control over my target audience![/Quote]
I heard that!


----------



## unklevig

Thanks everyone for you above help, but I'm running into a problem with the above code when I place it into my "Personal.xlsb" (it works perfect when ran from the macro in the "This Workbook" module). When I run the code from my personal workbook, since I want to run it on reports I receive, it is saving the new workbooks to where the "Personal.xlsb is located, so I changed it as follows with the intent of the new workbooks to be saved in the file location of the workbook I'm running the macro on:

FROM:
wb.SaveAs ThisWorkbook.Path & Application.pathseparator & C.Value & ".xlsx"
TO:
wb.SaveAs ActiveWorkbook.Path & Application.pathseparator & C.Value & ".xlsx"

I'm now getting a Run-time error of "1004: Microsoft Excel cannot access the file 'C:xxxxxx. There are several possible reasons: 
The file name or path does not exist
The file is being used by another program
The workbook you are trying to save has the same name as a currently open workbook."

Any help on making the macro work from my "Personal" workbook would be greatly appreciated.


----------



## 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.


----------



## JLGWhiz

unklevig said:


> Thanks everyone for you above help, but I'm running into a problem with the above code when I place it into my "Personal.xlsb" (it works perfect when ran from the macro in the "This Workbook" module). When I run the code from my personal workbook, since I want to run it on reports I receive, it is saving the new workbooks to where the "Personal.xlsb is located, so I changed it as follows with the intent of the new workbooks to b


I suggest you start a new thread.  Piggy back on an old thread is not a good way to get the best results from responders who volunteer their time and effort on the forum.  But when you start a new thread, more people will see the post and the odds are better at getting a good solution.


----------



## mradomir

JLGWhiz said:


> Try it this way.
> 
> 
> Code:
> __
> 
> 
> 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


I know that is very old thread, but it is a very useful for me, and thank you for that. I have additional question: I have to import additional cell from sheet "data" (for example from column R of the same row) in some other place of sheet "template" (for example in E6 cell). When I try to do this in the same way as you add cells from column Q of sheet "data" to sheet D10 cell in "template", I succeed but I always get cell from the last row, and I need it from the same row. Can you, please, help me?


----------



## sheetspread

mradomir said:


> I know that is very old thread, but it is a very useful for me, and thank you for that. I have additional question: I have to import additional cell from sheet "data" (for example from column R of the same row) in some other place of sheet "template" (for example in E6 cell). When I try to do this in the same way as you add cells from column Q of sheet "data" to sheet D10 cell in "template", I succeed but I always get cell from the last row, and I need it from the same row. Can you, please, help me?


lr is the last row, change it to whatever you want


----------

