[a_axe]

Elizavetta, могу предложить следующий код, но с оговорками:
Файлы лежат в папке "D:/metrology" и имеют следующие названия: pda391_2015-06-17_03.35.33.dat , где красная часть неизменна, синий нолик присутствует, если время менее 10 часов (в экселе в вашем примере этот ноль не отображается), черные символы - меняются.
Эти моменты принципиальны, так как в случае, если программа не найдет файл для копирования, файл будет пропущен.
Разница в 10 минут вычисляется с учетом секунд (т.е. в последовательности 10:05:14, 10:15:13, 10:15:14 второе значение будет пропущено, так как разница между первым и вторым 9:59).
Если необходимый файл успешно найден и скопирован - ячейка заливается зеленым цветом, если файл для копирования не найден - красным.
Первая строка содержит заголовки. Даты содержатся во втором столбце.
Строки не удаляются, вместо этого скрываются (их всегда можно отобразить).
Код желательно предварительно протестить на реальном примере. Если в реальном файле содержание будет отличаться от вашего примера (например даты будут записаны например в виде текста) - код выдаст ошибку.

Код

Код:

Public Sub Metrology()
    
    Dim i As Integer, j As Integer, n As Integer
    Dim myCell As Range
    Dim strFN As String
    Dim answ As Integer
    Dim diff As Double
    diff = 1 / 24 / 6
    n = ActiveSheet.Cells(2, 2).CurrentRegion.Rows.Count
    For i = 2 To n
        j = i + 1
        
        Do While j <= n And ActiveSheet.Cells(j, 2).Value - ActiveSheet.Cells(i, 2).Value <= diff
            ActiveSheet.Rows(j).Hidden = True
            j = j + 1
        Loop
        
        i = j - 1
        
    Next
    ActiveSheet.Rows(1).Hidden = True
    Intersect(ActiveSheet.Cells(2, 2).CurrentRegion, ActiveSheet.Columns(2)).SpecialCells(xlCellTypeVisible).Select
    For Each myCell In Selection
        If myCell.Value Like "##.##.#### #:##:##" Then
            strFN = "pda391_" & Replace(Replace(myCell.Value, " ", "_0") & ".dat", ":", ".")
        Else
            strFN = "pda391_" & Replace(Replace(myCell.Value, " ", "_") & ".dat", ":", ".")
        End If
        If Dir("d:\metrology\" & strFN) <> "" Then
            FileCopy "d:\metrology\" & strFN, "d:\metrology1\" & strFN
            myCell.Interior.Color = vbGreen
        Else
            '            answ = MsgBox("Отсутствует файл d:\metrology\" & strFN & ", он будет пропущен. Продолжить обработку дальше?", vbYesNo, "Ошибка!")
            '            If answ = vbNo Then Exit Sub
            myCell.Interior.Color = vbRed
        End If
    Next
    ActiveSheet.Rows(1).Hidden = False
End Sub