Есть данные (прикреплен файл). В файле перечисляются а/м (по гос номеру) в столбце А.  
Нужно найти а/м у которых в течение дня не было данных по открытию дверей, т.е. не было записей в строке с R по АА.  
Имеется макрос перебора файлов (данных по каждуму дню) с автофльтром. В данном случае автофильтр не помогает (в примере видно почему автофильтр не поможет).  
Уважаемые форумчане, помогите адаптировать существующий макрос для такого поиска.  
 
Option Explicit  
 
Sub Collect()  
 
Dim BazaWb As Workbook    'текущая книга (общий файл)  
   Dim BazaSht As Worksheet    'лист Price-group в общем файле  
   Dim iTempFileName As String    'имя поочерёдно открываемого файла  
   Dim iPath As String    'путь к папке, где лежат все файлы  
   Dim iLastRowBaza As Long    'последняя заполненная строка в общем файле в столбце C  
   Dim iLastRowTempWb As Long    'последняя заполненная строка в по-очерёдно открываемом файле в столбце C  
   Dim iNumFiles As Long    'количество открываемых файлов  
 
   Dim lr&, rr As Range  
 
   With Application  
       .ScreenUpdating = False  
       .DisplayAlerts = False  
       .Calculation = xlManual  
       Set BazaWb = ThisWorkbook  
       Set BazaSht = BazaWb.Sheets("ДанныеGPS")  
       iPath = BazaWb.Path & "\Данные_по_GPS\"  
       iTempFileName = Dir(iPath & "*.xls")  
         
       Sheets("ДанныеGPS").Select 'обнуление данных gps  
       Range("A3:BA10000").Select  
       Selection.ClearContents  
         
       Do While iTempFileName <> ""  
           If iTempFileName <> BazaWb.Name Then  
               With .Workbooks.Open _  
                    (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)  
                   iNumFiles = iNumFiles + 1  
                     
                   UserForm1.Label4.Caption = "Собирается информация по неисправностям МТ из файла:   " & iTempFileName  
                   UserForm1.Repaint  
                                       
                           'Рабочая книга не должна быть защищена паролем  
                   With .Worksheets(1)  
                       iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row  
                       iLastRowBaza = BazaSht.Cells(Rows.Count, 4).End(xlUp).Row + 1 'тут заменил 3 на 4!!! - не работало!  
                       '.Range(.Cells(3, 1), .Cells(iLastRowTempWb, "AA")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                         
                       '=======================  
                       lr = .Cells(1, 1).SpecialCells(xlLastCell).Row  
                                 
                               If IsDate(Range("i8").Value) And Application.WorksheetFunction.IsText(Range("i8").Value) Then  
                               Range(.Cells(8, 9), .Cells(lr, 9)).TextToColumns  
                               End If  
                                 
                       With .Rows(7)  
                           '.AutoFilter Field:=4, Criteria1:="=нет данных"  
                           .AutoFilter Field:=9, Criteria1:=">23:00:00"  
                       End With  
                         
                       Set rr = Intersect(.UsedRange.SpecialCells(xlCellTypeVisible), _  
                                          .Range(.Cells(8, 1), .Cells(lr, "AA")))  
                       If Not rr Is Nothing Then rr.Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                       .Rows(7).AutoFilter ' а это и не обязательно - всё равно закрываем без сохранения  
                       '=======================  
                         
                   End With  
                   .Close saveChanges:=False  
               End With  
           End If  
           iTempFileName = Dir  
             
       Loop  
       .Calculation = xlAutomatic  
       .DisplayAlerts = True  
       .ScreenUpdating = True  
         
   End With  
   UserForm1.Label4.Caption = ""  
   UserForm1.Repaint  
   'MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"  
End Sub