Sub test()

    If MsgBox("Начать массовое сохранение файлов?", vbYesNo + vbQuestion + vbDefaultButton2) <> vbYes Then
        Exit Sub
    End If

    Dim i, lr, cnt, a(), wb As Workbook, sh as Worksheet
    cnt = 0
    ' в текущем файле должен быть лист с именем "Sheet1", с данными в первых двух столбцах
    lr = ThisWorkbook.Worksheets("Sheet1").Cells.SpecialCells(xlLastCell).Row
    a = ThisWorkbook.Worksheets("Sheet1").Range(Cells(1, 1), Cells(lr, 2)).Value
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ' в текущем каталоге должен лежать файл КС-2.xls с образцом формы
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\КС-2.xls")
    Set sh = wb.Sheets(1)

    For i = 1 To lr
        If Len(a(i, 1)) > 0 Then
            sh.Range("F15").Value = a(i, 1)
            sh.Range("BA25").Value = "'" & a(i, 2)
            sh.Range("BL25").Value = Format(Date, "Short Date")
            wb.SaveAs (ThisWorkbook.Path & "\" & a(i, 1)), xlOpenXMLWorkbook
            cnt = cnt + 1
        End If
    Next
    
    wb.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Сохранено " & cnt & " файлов"
    
End Sub