Sub CreateWBs() Dim lRow, x As Integer Dim wbName As String lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 Do x = x + 1 wbName = Range("A" & x).Value & "_" & Range("B" & x).Value ActiveWorkbook.SaveAs Filename:="C:\Documents\" & wbName & ".xls" Loop Until x = lRow End Sub
Option Explicit Sub copyTemplate() Dim lRow, x As Integer Dim wbName As String Dim fso As Variant Dim dic As Variant Dim colA As String Dim colB As String Dim colSep As String Dim copyFile As String Dim copyTo As String Set dic = CreateObject("Scripting.Dictionary") 'dictionary to ensure that duplicates are not created Set fso = CreateObject("Scripting.FileSystemObject") 'file scripting object for fiile system manipulation colSep = "_" 'separater between values of col A and col B for file name dic.Add colSep, vbNullString ' ensuring that we never create a file when both columns are blank in between 'get last used row in col A lRow = Range("A" & Rows.Count).End(xlUp).Row x = 1 copyFile = "C:\Document\Template\Termplate.xls" 'template file to copy copyTo = "C:\Document\projects\" 'location where copied files need to be copied Do x = x + 1 colA = Range("A" & x).Value 'col a value colB = Range("B" & x).Value ' col b value colB = Left(Range("B" & x).Value, 20) 'only retain first 20 characters wbName = colA & colSep & colB ' create new file name If (Not dic.Exists(wbName)) Then 'ensure that we have not created this file name before fso.copyFile copyFile, copyTo & wbName & ".xls" 'copy the file dic.Add wbName, vbNullString 'add to dictionary that we have created this file End If Loop Until x = lRow Set dic = Nothing ' clean up Set fso = Nothing ' clean up End Sub