ct =  2 
    mysheet.Rows("1:1").Select
    
    With myOlApp.Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation =  90 
        .AddIndent = False
        .IndentLevel =  0 
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    ct =  2 
    URang =  2 
    URang1 = URang +  8 
    Do Until MyRst.EOF
    If MyRst![Rang_ID] =  0  Then
        mysheet.Cells(ct,  2 ).Select
        myOlApp.Selection.Font.Bold = True      '1
        myOlApp.Selection.Font.Italic = True    '2
        mysheet.Range("a" & URang & ":" & "a" & URang1).Select
    With myOlApp.Selection
        .VerticalAlignment = xlJustify  '3
        .MergeCells = True   '4
    End With
    URang = URang +  8 
    URang1 = URang +  8 
    End If
    ct = ct +  1 
    MyRst.MoveNext
    Loop

    ct =  2 
    URang =  2 
    URang1 = URang + [color=red] 7 [/color]
    Do Until MyRst.EOF
    If MyRst![Rang_ID] =  0  Then
        mysheet.Cells(ct,  2 ).Select
        myOlApp.Selection.Font.Bold = True      '1
        myOlApp.Selection.Font.Italic = True    '2
        mysheet.Range("a" & URang & ":" & "a" & URang1).Select
    With myOlApp.Selection
        .VerticalAlignment = xlJustify
        .MergeCells = True
    End With
    URang = URang +  8 
    URang1 = URang + [color=red] 7  [/color]
    End If
    ct = ct +  1 
    MyRst.MoveNext
    Loop

.MergeCells = True

Application.DisplayAlerts = False

'.................
        mysheet.Range("a" & URang & ":" & "a" & URang1).Select ' Вроде выделил
    With myOlApp.Selection
        .VerticalAlignment = xlJustify ' Операции -?
        .MergeCells = True
     End With
'.................