Sub CreatFiles()
    Dim strFilename, strDirname, strPathname, strDefpath As String
    Dim bkNew As Workbook
    strDirname = "ТЕСТ2" ' New directory name
 
    strFilename = Intersect(Range("ДДС[Реквизиты]"), ActiveCell.EntireRow).Value 'New file name
    strDefpath = Application.ActiveWorkbook.Path 'Default path name
    If IsEmpty(strDirname) Then Exit Sub
    If IsEmpty(strFilename) Then Exit Sub
 
    On Error Resume Next ' If directory exist goto next line
    MkDir strDefpath & "\" & strDirname
    On Error GoTo 0
    strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
    MsgBox strPathname
     
    'Создание книги из шаблона, внутри кавычек укажите путь и имя книги-шаблона.
    Set bkNew = Workbooks.Add(Template:="")
    'Сохранение книги-шаблона.
    bkNew.SaveAs Filename:=strPathname & ".xls", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Sub CreatFiles2()
    Dim strFilename, strDirname, strPathname, strDefpath As String
    Dim strFilenameTemplate As String
    strDirname = "ТЕСТ2" ' New directory name
 
    strFilename = Intersect(Range("ДДС[Реквизиты]"), ActiveCell.EntireRow).Value 'New file name
    strDefpath = Application.ActiveWorkbook.Path 'Default path name
    If IsEmpty(strDirname) Then Exit Sub
    If IsEmpty(strFilename) Then Exit Sub
 
    On Error Resume Next ' If directory exist goto next line
    MkDir strDefpath & "\" & strDirname
    On Error GoTo 0
    strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
    MsgBox strPathname
    
    'В переменную напишите путь и имя книги-шаблона.
    strFilenameTemplate = ""
    VBA.FileSystem.FileCopy strFilenameTemplate, strPathname
End Sub