Sub createFiles()
    Application.ScreenUpdating = False
    Dim sh As Worksheet, wb As Workbook
    Set sh = ThisWorkbook.Sheets("3 кв 2016")
    With sh
        For i = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(i, "k") = "шаблон 1" Then
                'ThisWorkbook.Path & "\шаблон 1.xls - путь в к шаблону 1
                Set wb = Workbooks.Open(ThisWorkbook.Path & "\шаблон 1.xls")
            Else
                'ThisWorkbook.Path & "\шаблон 2.xls - путь в к шаблону 2
                Set wb = Workbooks.Open(ThisWorkbook.Path & "\шаблон 2.xls")
            End If
            With wb.Sheets(1)
                .[d5] = sh.Cells(i, "b")
                .[d6] = sh.Cells(i, "d")
                .[h5] = sh.Cells(i, "e")
                .[h7] = sh.Cells(i, "j")
            End With
            wb.SaveCopyAs ThisWorkbook.Path & "\" & sh.Cells(i, "b") & ".xls"
            wb.Close False
        Next i
    End With
    Application.ScreenUpdating = True
End Sub