Public Sub Formtt3(n_workbook) ', n_vxod, v_end)
  Dim rfont(1 To 1022, 0 To 35000) As Byte
  Dim rock5(1 To 80) As Long
  Application.Calculation = xlCalculationManual
  n_workbook = 1
  Sheets(n_workbook).Select
  iLastCell_4 = Worksheets(n_workbook).Range("A1:A65000").End(xlDown).Row 
  j_tek = 1
  yy = 1
  While yy < iLastCell_4 
   yy = yy + 950
23:      first_s = Left(Worksheets(n_workbook).Cells(yy, 3).Value, 1)
   If (first_s <> "~") Then rock5(j_tek) = yy: j_tek = j_tek + 1 Else: yy = yy - 1: GoTo 23
            
  Wend
  rock5(j_tek) = iLastCell_4
 '---------------------------------
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
 'Application.EnableEvents = False
 '---------------------------------
  n_vxod = 1
For kk = 1 To j_tek - 1 
  v_end = rock5(kk)
  Application.Calculation = xlCalculationManual
  n_workbook = 1
  Sheets(n_workbook).Select
  Columns("J:J").ColumnWidth = 51.43
  Columns("K:K").ColumnWidth = 95.43
  iLastCell_4 = Worksheets(n_workbook).Range("A1:A65000").End(xlDown).Row '&#234;&#238;&#235;_&#226;&#238; &#237;&#224; 4&#236; &#235;&#232;&#241;&#242;&#229;
  j_schet = 0
  j_nach = 0
  s = ""
  For j = n_vxod To v_end 'iLastCell_4 
   If j = n_vxod Then j_r = 1 Else j_r = j - n_vxod 
   first_s = Left(Worksheets(n_workbook).Cells(j, 3).Value, 1)
   If first_s = "~" Then
                       If j_nach = 0 Then j_nach = j - 1 Else j_schet = j_schet + 1

   'Application.StatusBar
   
  If (j_nach > 0) Or (j_schet > 0) Then s = Worksheets(n_workbook).Cells(j_nach, 2).Value + " "
                                       j_format = 1 ' &#241;&#247;&#229;&#242;&#247;&#232;&#234; &#239;&#238; &#238;&#244;&#238;&#240;&#236;&#235;&#229;&#237;&#232;&#254; &#241;&#243;&#236;&#224;&#240;&#237;&#251;&#233;
                                       l1 = Len(Worksheets(n_workbook).Cells(j_nach, 2).Value)
                                       If j_nach = n_vxod Then zik = 1 Else zik = j_nach - n_vxod
                                       'If j_nach = v_end Then zik = v_end
                                       rfont(zik, 0) = 1 ' &#239;&#240;&#232;&#231;&#237;&#224;&#234; &#231;&#224;&#239;&#238;&#235;&#237;&#229;&#237;&#232;&#255;
                                       's_adr5 = "B" + Right(Str(j_nach), Len(Str(j_nach)) - 1) 
                                      ' Range (s_adr5)
                                        For qq = 1 To l1
                                             If Worksheets(n_workbook).Cells(j_nach, 2).Characters(qq, 1).Font.Bold = True Then rfont(zik, j_format) = 2
                                            If Worksheets(n_workbook).Cells(j_nach, 2).Characters(qq, 1).Font.Italic = True Then rfont(zik, j_format) = 3
                                            j_format = j_format + 1
                                        Next qq
                                        j_format = j_format + 1 
                                       For Z = 1 To j_schet + 1
                                          l2 = Len(Worksheets(n_workbook).Cells(j_nach + Z, 1).Value)
                                          For qq = 1 To l2
                                            rfont(zik, j_format) = 2 '&#239;&#238; ~ &#230;&#232;&#240;&#237;&#251;&#236;
                                            j_format = j_format + 1
                                          Next qq
                                          l3 = Len(Worksheets(n_workbook).Cells(j_nach + Z, 2).Value)
                                          For qq = 1 To l3
                                            If Worksheets(n_workbook).Cells(j_nach + Z, 2).Characters(qq, 1).Font.Bold = True Then rfont(zik, j_format) = 2
                                            If Worksheets(n_workbook).Cells(j_nach + Z, 2).Characters(qq, 1).Font.Italic = True Then rfont(zik, j_format) = 3
                                            j_format = j_format + 1
                                          Next qq
                                         'Worksheets(n_workbook).Cells(j_nach, 11).Value = Worksheets(n_workbook).Cells(j_nach, 11).Value + " " + Worksheets(n_workbook).Cells(j_nach + Z, 1).Value + " " + Worksheets(n_workbook).Cells(j_nach + Z, 2).Value + ";"
                                         j_format = j_format + 1 '&#243;&#247;&#229;&#242; ;
                                         'With Worksheets(n_workbook).Cells(j_nach, 11)
                                         '  .Characters(l1 + 1, l2 - 1).Font.Bold = True
                                         'End With
                                         a = Worksheets(n_workbook).Cells(j_nach + Z, 1).Value + " " + Worksheets(n_workbook).Cells(j_nach + Z, 2).Value + ";"
                                         s = s + a
                                         j_format = j_format + 1
                                        Next Z
                                        Worksheets(n_workbook).Cells(j_nach, 11).Value = s
                                        Worksheets(n_workbook).Cells(j_nach, 11).Font.Bold = False
                                        Worksheets(n_workbook).Cells(j_nach, 11).Font.Italic = False
                                        
                                     Else: sos1 = Right(Str(j), Len(Str(j)) - 1)
                                           sos2 = "A" + sos1 + ":B" + sos1
                                           Range(sos2).Select
                                           Selection.Copy
                                           Range("J" + sos1).Select
                                           ActiveSheet.Paste
                                           
                                           j_schet = 0
                                           j_nach = 0
                                           s = ""
                                           
                                     End If



 Next j

For j = n_vxod To v_end
  If j = n_vxod Then j_r = 1 Else j_r = j - n_vxod ' &#224;&#228;&#240;&#229;&#241;&#224;&#246;&#232;&#255; &#237;&#224; &#236;&#224;&#241;&#241;&#232;&#226; &#228;&#235;&#255; &#244;&#238;&#240;&#236;&#224;&#242;&#232;&#240;&#238;&#226;&#224;&#237;&#232;&#255;
  If rfont(j_r, 0) = 1 Then
        fff_0 = Len(Worksheets(n_workbook).Cells(j, 11).Value)
        For qq = 1 To fff_0
           If rfont(j_r, qq) = 2 Then
            With Worksheets(n_workbook).Cells(j, 11)
                .Characters(qq, 1).Font.Bold = True
            End With
           End If
           '----------------
           If rfont(j_r, qq) = 3 Then
            With Worksheets(n_workbook).Cells(j, 11)
                .Characters(qq, 1).Font.Italic = True
            End With
           End If
        Next qq
  End If
Next j
n_vxod = v_end ' &#239;&#229;&#240;&#229;&#228;&#224;&#229;&#236; &#237;&#224; &#241;&#235;&#229;&#228;&#254;&#249;&#243;&#254;
 '===========================
 ChDir "X:\_11"
    ActiveWorkbook.SaveAs Filename:= _
        "X:\_0807" + Str(kk) + ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 'ActiveWorkbook.Save
 '============================
Next kk '
Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 ActiveWorkbook.Save
End Sub