Option Explicit
Private Const OPTION_STRING = "1 стр1 BZ6; 2 стр1 M17; 3 стр1 W15; 4 стр2 EQ9"
Private wbTemp As Workbook

Sub Заполнить_шаблон()
    Set wbTemp = Workbooks("шаблон.xls")
    
    CloseEmptyWb
    
    Dim rSource As Range
    On Error Resume Next
    Set rSource = Selection.EntireRow
    Set rSource = Intersect(rSource, rSource.Parent.UsedRange)
    On Error GoTo 0
    If rSource Is Nothing Then Exit Sub
    
    Dim rowSource As Range
    For Each rowSource In rSource.Rows
        If Not rowSource.Hidden Then
            FillOneFile rowSource
        End If
    Next
End Sub

Private Sub FillOneFile(rowSource As Range)
    wbTemp.Sheets.Copy
    Dim wbTarg As Workbook
    Set wbTarg = ActiveWorkbook
    
    Dim vOption As Variant, rSource As Range, rTarget As Range, wasChanged As Boolean
    For Each vOption In Split(OPTION_STRING, ";")
        vOption = Trim(vOption)
        vOption = Split(vOption, " ")
        On Error Resume Next
        Set rSource = rowSource.Cells(1, CLng(vOption(0)))
        Set rTarget = wbTarg.Sheets(vOption(1)).Range(vOption(2))
        On Error GoTo 0
        If Not rSource Is Nothing Then
            If Not rTarget Is Nothing Then
                rTarget.Value = rSource.Value
                wasChanged = True
            End If
        End If
        Set rSource = Nothing
        Set rTarget = Nothing
    Next
    If wasChanged Then
        SaveTargetWorkbook wbTarg
    Else
        wbTarg.Close False
    End If
End Sub

Private Sub SaveTargetWorkbook(wbTarg As Workbook)

    Dim sName As String
    sName = wbTarg.Sheets(1).Range("BZ6").Value
    sName = sName & "." & CreateObject("Scripting.FileSystemObject").GetTempName
    ReplaceSymbols sName
    sName = sName & ".xlsx"
    
    Dim sFull As String
    sFull = ThisWorkbook.Path & "\" & sName
    On Error Resume Next
    Workbooks(sName).Close False
    Kill sFull
    Err.Clear
    wbTarg.SaveAs Filename:=sFull, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Debug.Print sFull
    If Err = 0 Then wbTarg.Close False
    On Error GoTo 0

End Sub

Sub ReplaceSymbols(ss As String)
    Dim vv As Variant
    For Each vv In Array("\", "/", ":", "*", "?", """", "<", ">", "|", "[", "]") '[] недопустимые только в имени листа
        ss = Replace(ss, vv, " ")
    Next
    ss = Trim(ss) 'Пробел в конце строки не распознаётся файловой системой.
End Sub


Private Sub CloseEmptyWb()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.Path = "" Then wb.Close False
    Next
End Sub