Create Multiple Files using Template with Files Names in a Column List

[dmdek]

Could someone please assist with a problem I cannot think through. I want to use 1 template file and then "save as" renaming the file 200+.

The file names will pick up their names from a column list. I was hoping the macro will have a variable so that I can indicate where the files should be stored.

I cannot figure out how to loop through the cells in the column to pick up the file names.


Thank you in advance.

Dan



Excel 2003

 

[Sydcomebak]

Using your method above, iliace, I got this to work:

Public Sub SaveTemplate()
  Const strTemplatePath As String = "T:\Completed Task Checklists\Checklist - AutoDate(Enable Macros).xlsm"
  Const strSavePath As String = "T:\Completed Task Checklists\2017 (Testing Ground)\"


  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
  
  Set rngNames = ThisWorkbook.Worksheets("Sheet1").Range("A1:A3").Cells
  Set fldrNames = ThisWorkbook.Worksheets("Sheet1").Range("B1:B3").Cells
  
  Set wkbTemplate = Application.Workbooks.Open(strTemplatePath)
  
  For Each rng In rngNames.Cells
    wkbTemplate.SaveAs strSavePath & "01-January\" & rng.Value
  Next rng
  
  wkbTemplate.Close SaveChanges:=False
End Sub

In the area where the wkbTemplate.SaveAs is used, I want to change:

"01-January"

to:

B1.value & "" on the 1st
B1.value & "" on the 2nd
B1.value & "" on the 3rd

etc...

I set up the 2nd range of cells, but I am at a loss as to how to call the value.

Can you help?

Thanks!

-Dave

 

[Sydcomebak]

Cannot edit prev post:

-=-=-=-=-=-=-=-=-


In the area where the wkbTemplate.SaveAs is used, I want to change:

"01-January"

to:

B1.value & "" on the 1st
B2.value & "" on the 2nd
B3.value & "" on the 3rd

etc...

 

[iliace]

Maybe try something like this:

Public Sub SaveTemplate()  Const strTemplatePath As String = "T:\Completed Task Checklists\Checklist - AutoDate(Enable Macros).xlsm"
  Const strSavePath As String = "T:\Completed Task Checklists\2017 (Testing Ground)\"




  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
  
  Dim iCount As Long
  Dim sAddress As String
  
  Set rngNames = ThisWorkbook.Worksheets("Sheet1").Range("A1:A3").Cells
  Set fldrNames = ThisWorkbook.Worksheets("Sheet1").Range("B1:B3").Cells
  
  Set wkbTemplate = Application.Workbooks.Open(strTemplatePath)
  
  iCount = 0
  For Each rng In rngNames.Cells
	iCount = iCount + 1
	sAddress = Range("B" & iCount mod 3 + 1)
    wkbTemplate.SaveAs strSavePath & Range(sAddress) & rng.Value
  Next rng
  
  wkbTemplate.Close SaveChanges:=False
End Sub

 

[Sydcomebak]

Thank-you!

 

[dibagante]

Thank you very much for your quick response sir...

I tried the code with modifications as u suggested...

Am getting a run time error '438'
Object doesn't support this property or method

And I need to copy the information from those individual cell to be copied to different cells in the template.. I.e b3 of current sheet to a11 of template , c3 to d6 etc.

Hi amaresh achar,

Did you got a reply for your problem?
I have the exactly same case as you and I haven't succeed to make it work.

Thanks in advance

 

[Akhi]

Let's say the file names are in the current workbook, Sheet1, A1:A200. You have a file called template.xls in C:\My Documents, and you want to save your new files in C:\My Documents.

Public Sub SaveTemplate()
  Const strSavePath As String = "C:\My Documents\"
  Const strTemplatePath As String = "C:\My Documents\template.xls"

  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
 
  Set rngNames = ThisWorkbook.Worksheets("Sheet1").Range("A1:A200").Values
 
  Set wkbTemplate = Application.Workbooks.Open(strTemplatePath)
 
  For Each rng In rngNames.Cells
    wkbTemplate.SaveAs strSavePath & rng.Value
  Next rng
 
  wkbTemplate.Close SaveChanges:=False
End Sub

Hi IliAce,
I tried the above code with change Value to Cell , It worked very well. I need to thank you very much.

I need one variation that Can I save changes at cell H16 in each new file with cell range B2:B200

What I want to say that each new file should have the name from range A2:A200 and Cell H16 should have the name from Range B2:B200

 

[iliace]

Hi IliAce,
I tried the above code with change Value to Cell , It worked very well. I need to thank you very much.

I need one variation that Can I save changes at cell H16 in each new file with cell range B2:B200

What I want to say that each new file should have the name from range A2:A200 and Cell H16 should have the name from Range B2:B200

Good catch on the change, thank you.

Not sure I understand the additional request - do you mean like this?

Public Sub SaveTemplate()
  Const strSavePath As String = "C:\My Documents\"
  Const strTemplatePath As String = "C:\My Documents\template.xls"

  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
 
  Set rngNames = ThisWorkbook.Worksheets("Sheet1").Range("A1:A200").Cells
 
  Set wkbTemplate = Application.Workbooks.Open(strTemplatePath)
 
  For Each rng In rngNames.Cells
    wkbTemplate.Range("H16") = rng.Offset(0, 1).Value
    wkbTemplate.SaveAs strSavePath & rng.Value
  Next rng
 
  wkbTemplate.Close SaveChanges:=False
End Sub

 

[Akhi]

Good catch on the change, thank you.

Not sure I understand the additional request - do you mean like this?

Public Sub SaveTemplate()
  Const strSavePath As String = "C:\My Documents\"
  Const strTemplatePath As String = "C:\My Documents\template.xls"

  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
 
  Set rngNames = ThisWorkbook.Worksheets("Sheet1").Range("A1:A200").Cells
 
  Set wkbTemplate = Application.Workbooks.Open(strTemplatePath)
 
  For Each rng In rngNames.Cells
    wkbTemplate.Range("H16") = rng.Offset(0, 1).Value
    wkbTemplate.SaveAs strSavePath & rng.Value
  Next rng
 
  wkbTemplate.Close SaveChanges:=False
End Sub

The Cell value at H16 has to be taken from range B2:B200

 

[Akhi]

wkbTemplate.Range("H16") = rng.Offset(0, 1).Value

I think this needs correction to take value from cells B2:B200 and not from A2:A200

 

[iliace]

That's what .Offset(0, 1) does - offset 0 rows, 1 column. So if rng is A2, then rng.Offset(0,1) is B2.