Copy a Workbook Multiple Time and Rename based on a list

[mdpw]

Hello,

I need to duplicate a workbook multiple times and rename the new workbook based on a list of names. I found this code and it worked once but now I get an error. The workbook does contain multiple sheets.

Sub SaveMasterAs()
Dim wb As Workbook
Dim rNames As Range, c As Range, r As Range
Set rNames = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Range("A2").End(xlDown))
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Template.xlsx")
For Each c In rNames
With wb
'.Worksheets("Sheet1").Range("A1").Value = c.Offset(, 1).Value 'ID
'Path and name for copied workbook
.SaveAs Filename:=ThisWorkbook.Path & "\Template Copy\" & c.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End With
Set wb = ActiveWorkbook
Next c
wb.Close
End Sub

 

[DanteAmor]

Hi and welcome to MrExcel.

It is necessary to open the file or copying the file with the new names is enough:

Sub CopyTemplate()
  Dim c As Range
  For Each c In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(3))
    FileCopy ThisWorkbook.Path & "\Template.xlsx", ThisWorkbook.Path & "\Template copy " & c.Value & ".xlsx"
  Next c
End Sub

 

[ironny90]

Just tested the code above and it says bad file name or number?

 

[DanteAmor]

Just tested the code above and it says bad file name or number?

With which data you are running the macro, you can be more specific.

 

[ironny90]

Sub addnewworkbook()
Set template = ActiveWorkbook
Set namelist = Workbooks("Name List.xlsm")
  namelist.Activate
  Dim c As Range
  Dim targetworkbookpath As Variant
  targetworkbookpath = Range("F1").Value
  For Each c In Sheets("Test").Range("A2", Sheets("Test").Range("A" & Rows.Count).End(3))
    FileCopy template, targetworkbookpath & c.Value & ".xlsx"
  Next c

End Sub

Thank you for your quick response! Just edited the code and it's saying object doesn't support this property on the filecopy line. I wonder if template has to be closed before it's copied?

 

[ironny90]

Sub addnewworkbook()
Dim template As String
template = "C:\Users\Template_ ABC_2022-03-31"
Set namelist = Workbooks("ABC Name List.xlsm")
  namelist.Activate
  Dim c As Range
  Dim targetworkbookpath As String
  targetworkbookpath = Range("F1").Value
  For Each c In Sheets("Test").Range("A2", Sheets("Test").Range("A" & Rows.Count).End(3))
    FileCopy template, targetworkbookpath & c.Value & ".xlsx"
  Next c

End Sub

Just edited the code. It seems like it can't copy opened workbook. Now it's saying file not found on the filecopy row...

 

[DanteAmor]

template = "C:\Users\Template_ ABC_2022-03-31"

Check that the folder and name are spelled correctly. The file extension is missing.

targetworkbookpath = Range("F1").Value

What you have in cell F1, you need to be even more specific. At the end of the data in cell F1 do you have the Backslash "\"?

Range("A2"

An example of the data you have in cell A2.

namelist.Activate

And the active sheet of your book is the "Test" sheet?

 

[ironny90]

Check that the folder and name are spelled correctly. The file extension is missing.


What you have in cell F1, you need to be even more specific. At the end of the data in cell F1 do you have the Backslash "\"?


An example of the data you have in cell A2.


And the active sheet of your book is the "Test" sheet?

Good points Let me go back and check.

 

[ironny90]

Check that the folder and name are spelled correctly. The file extension is missing.
added extension
What you have in cell F1, you need to be even more specific. At the end of the data in cell F1 do you have the Backslash "\"?
path to the folder that I want the copies to be in
An example of the data you have in cell A2.
List of product names

Duland Village

And the active sheet of your book is the "Test" sheet? - that's a good question. There is only one sheet in the file - a dummy file to make copies of the template. But it potentially can be a problem.

Sub addnewworkbook()
Dim template As String
template = "C:\Macro\ABC\Template - ABC_2022-03-31.xlsx" ' added extension
Set namelist = Workbooks("ABC Name List.xlsm") 
  namelist.Activate ' it's a good question to ask if test is the active sheet. There is only one sheet so it wasn't a problem. But it could be. 
  Dim c As Range
  Dim targetworkbookpath As String
  targetworkbookpath = Range("F1").Value ' filepath to the target folder. added "\" to the end of the file path
  For Each c In Sheets("Test").Range("A2", Sheets("Test").Range("A" & Rows.Count).End(3))
    FileCopy template, targetworkbookpath & c.Value & ".xlsx"
  Next c

End Sub

I just tried the code above and it worked!!! Thank you soooo much!!!

 

[DanteAmor]

I'm glad to hear that. Thanks for commenting.