Sub test()
Dim R As Range
  For Each R In Columns( 2 ).SpecialCells(xlCellTypeFormulas)
    MsgBox R.EntireRow.Address
  Next R
End Sub

Set objRange = objExcel.Selection.Find("ПРОМЕЖУТОЧНЫЕ.ИТОГИ", LookIn:=xlFormulas)

        If Not objRange Is Nothing Then
            firstAddress = objRange.Address
            Do
                objSheet.Rows(objRange.Row).Interior.ColorIndex =  15 
                With Range(objSheet.Cells(objRange.Row,  1 ), objSheet.Cells(objRange.Row, objRange.Column -  1 ))
                    .Merge
                    .HorizontalAlignment = xlLeft
                End With
                Set objRange = objExcel.Selection.Find("ПРОМЕЖУТОЧНЫЕ.ИТОГИ", After:=objRange, LookIn:=xlFormulas)
                If objRange Is Nothing Then Exit Do
            Loop While objRange.Address <> firstAddress
        End If