И еще раз добрый день, дамы и господа! Есть небольшой макрос, который ест 200 мб оперативки и не отдает по завершению! Эка наглость! Надо его наказать и отобрать память. Принимаются любые советы по поводу его модернизации.  
 
Sub Test()  
 
Dim UniqueValues As Variant  
Dim i As Long  
 
Application.ScreenUpdating = False  
 
i = 0  
Set UniqueValues = New Collection  
 
With Worksheets("ReportView").Range("C8:I72089")  
   Set c = .Find(What:="Итог", LookIn:=xlValues, LookAt:=xlPart)  
   If Not c Is Nothing Then  
       firstAddress = c.Address  
       Do  
           On Error Resume Next  
             UniqueValues.Add CStr(c.Row), CStr(c.Row)  
             If Err = 0 Then  
               i = i + 1  
               Cells(UniqueValues(i), 3).Select  
               Selection.EntireRow.Hidden = True  
             End If  
           On Error GoTo 0  
           Set c = .FindNext©  
           On Error Resume Next  
       Loop While Not c Is Nothing And c.Address <> firstAddress  
       On Error GoTo 0  
   End If  
.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Temp").Range("A1")  
Worksheets("ReportView").Range("8:72089").DELETE  
Sheets("Temp").Range("A1:Q22837").Copy Worksheets("ReportView").Range("A8")  
 
End With  
 
Application.ScreenUpdating = True  
Set UniqueValues = Nothing  
Set c = Nothing  
 
End Sub