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