Sub format_Sub_String(top As Integer, left As Integer, rows As Integer, columns As Integer)
Dim str_copy As String, LT As Integer, RB As Integer, i As Integer

' ÎÏÐÅÄÅËÈÒÜ ÔÎÐÌÀÒ ÏÎÑËÅÄÍÞÞ ÑÒÐÎÊÓ ÒÀÁËÈÖÛ
  str_copy = str_range(top + 2, left, 1, columns)
  Selection.Copy        ' ñêîïèðîâàòü
  str_copy = str_range(top + rows - 1, left, 1, columns)
  Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False


' îïðåäåëÿåì äèàïàçîí ñòðîêè, ôîðìàò êîòîðîé êîïèðóþò
  str_copy = str_range(top + 1, left, 1, columns)
  Selection.Copy
' îïðåäåëÿåì äèàïàçîí ñòðîê, â êîòîðûé ôîðìàòèðóåì
  str_copy = str_range(top + 2, left, rows - 3, columns)
  Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False

' î÷èñòèòü ÿ÷åéêó ñïðàâà îò íàäïèñè "ÈÒÎÃ:"
  str_copy = str_range(top + rows - 1, left + 1, 1, 1)
  Selection.ClearContents
  ActiveCell.Value = ""

  str_copy = str_range(top + rows + 3, left, 10, 2)
  With Selection
       .HorizontalAlignment = xlLeft
       .Font.Bold = True
  End With


  For i = top To top + rows - 2
    str_copy = str_range(i, left + 2, 1, 1)
'   åñëè ÿ÷åéêà ïóñòàÿ, òî îòôîðìàòèðîâàòü ñòðîêó
    If ActiveCell.Value = "" Then
       str_copy = str_range(i, left, 1, columns)
'      ñåðàÿ âíóòðåííîñòü
       With Selection.Interior
            .ColorIndex = 15
            .Pattern = xlSolid
       End With
       Selection.Font.Bold = True  ' æèðíûé øðèôò
    End If
  Next i


  str_copy = str_range(top, left, 1, 1)
End Sub


Function str_range(top As Integer, left As Integer, rows As Integer, columns As Integer) As String
  LT = Asc("A") + left - 1     ' ASC êîä áóêâû ëåâîé êîëîíêè
  RB = LT - 1 + columns ' ASC êîä áóêâû ïðàâîé êîëîíêè
' ÎÏÐÅÄÅËÈÒÜ ÔÎÐÌÀÒ ÏÎÑËÅÄÍÞÞ ÑÒÐÎÊÓ ÒÀÁËÈÖÛ
' îïðåäåëÿåì äèàïàçîí ñòðîêè, êîòîðóþ êîïèðóþò
  str_copy = Trim$(Chr(LT)) & Trim$(Str(top)) & ":" & _
             Trim$(Chr(RB)) & Trim$(Str(top + rows - 1))
  range(Cells(top, left), Cells(top + rows - 1, left + columns - 1)).Select
  ' Range(str_copy).Select

  str_range = str_copy
End Function


Sub PrepareRows(top As Long, lines As Long)
Dim i As Long
'Dim top As Long
Dim ch_top As String
Dim add_lines As Long
Dim ch_add_lines As String
Dim range As String
Dim ostatok As Long
Dim c4ak As Long
Dim all As Long
    ActiveWindow.WindowState = xlMaximized
    Application.WindowState = xlMaximized
    Application.CutCopyMode = False

    If lines < 3 Then

        If lines = 0 Then
            For i = 1 To 3 - 1
                rows(top).Select
                Selection.Delete Shift:=xlUp
            Next i

        Else
            For i = 1 To 3 - lines
                rows(top).Select
                Selection.Delete Shift:=xlUp
            Next i
        End If
    End If

    If lines > 3 Then
        lines = lines - 3
        ostatok = lines Mod 2
        top = top + 1
        ch_top = top
        add_lines = top
        While lines <> 0 And lines > 0
            If add_lines - top > lines Then
                add_lines = top + lines - 1
            End If
            ch_add_lines = add_lines
            range = ch_top + ":" + ch_add_lines
            'If ostatok = 0 Then ' ÷åòíîå
            rows(range).Select
            'ElseIf ostatok = 1 Then ' íå÷åòíîå
            'End If
            Selection.Insert Shift:=xlDown
            add_lines = add_lines + 1
            c4ak = add_lines - top
            all = all + c4ak
            lines = lines - c4ak
        Wend
    End If

    'range("B1").Select
End Sub




Sub Merge_itog_str(top As Integer, strMyString As String)

  'Dim top As Integer
  Dim Ik As Integer
  Dim arrMyArray() As String
  'Dim strMyString As String
  'strMyString = "178/173/171/112/44/42/40/36/30/28/25/18/16/14/11/"
  'strMyString = "4/6/7/" - òàê äîëæíà âûãëÿäåòü ñòðîêà 178/173/171/112/44/42/40/36/30/28/25/18/16/14/11/
  arrMyArray = Split(strMyString, "/")

For Ik = LBound(arrMyArray) To UBound(arrMyArray) - 1
Worksheets("P01").range(Cells(arrMyArray(Ik) + top - 1, 2), Cells(arrMyArray(Ik) + top - 1, 9)).Select
K = K + 1
Dim irow As range, icel As range, MergeVal As String
 Application.DisplayAlerts = False
   For Each irow In Selection.rows
     For Each icel In irow.Cells
       If icel.Value <> "" Then MergeVal = MergeVal & icel.Value & " "
     Next icel
   If MergeVal <> "" Then irow(1).Value = left(MergeVal, Len(MergeVal) - 1)
   MergeVal = ""
   irow.Merge
   Next irow
Selection.rows.AutoFit
Selection.HorizontalAlignment = xlLeft
Selection.rows.Font.Bold = True
 Application.DisplayAlerts = True
 'Application.DisplayAlerts = True



Worksheets("P01").range(Cells(arrMyArray(Ik) + top - 1, 1), Cells(arrMyArray(Ik) + top - 1, 33)).Select
 Selection.rows.Font.Bold = True
Next Ik
range("B1").Select

End Sub