Сортировка столбцов и вставка на новый лист, если определенные ячейки соответствуют критериям

Question

Я новичок в StackOverflow и вроде fre sh также в Excel VBA, и я надеюсь найти ответы и, в конечном итоге, также дать ответы.

Вот моя проблема: Лист 1 (Называется «Беспорядочно») ) имеет множество значений, собранных с разных датчиков, которые хранятся в каждом другом столбце. В столбце слева для каждого значения датчика указана временная метка для каждого значения датчика. Смотрите картинку. Не все отметки времени одинаковы, что вызывает проблемы. Мне нужно вставить значения, которые имеют одинаковую отметку времени, на новый лист. У меня две мысли о циклах поиска в каждом столбце в поисках значения в первых столбцах каждой строки. После нескольких неудачных попыток я выбрал функцию Range.Find. Я получаю странный результат, и поиск занял целую вечность. Использование функции поиска даже рекомендуется внутри (два) для l oop (s)? Кто-нибудь с эффективной и правильной точки зрения на эту проблему? Буду очень признателен за любые рекомендации и советы :) Маленький пик набора данных

    Private Sub CommandButton1_Click()
Dim rH As Long
Dim Row As Long
Dim Col As Long
Dim RowSize As Integer
Dim ColSize As Integer
Dim foundRng As Range
Set DataArk = Worksheets("Disorderly")
Set ResArk = Worksheets("Organized")
'Copy the first two rows
rH = 1
    For Row = 1 To 2
        ResArk.Rows(Row).EntireRow.Value = DataArk.Rows(rH).EntireRow.Value
        rH = rH + 1
    Next Row
'Copy column 1 and 2 in DataArk
    DataArk.Columns(1).Copy Destination:=ResArk.Columns(1)
    DataArk.Columns(2).Copy Destination:=ResArk.Columns(2)
'Search through every second column for the associated timestamp in column 1
RowSize = DataArk.Cells(Rows.Count, 1).End(xlUp).Row
ColSize = DataArk.Cells(3, Columns.Count).End(xlToLeft).Column
    For Col = 3 To ColSize Step 2
        For Row = 3 To RowSize
            Set foundRng = Range(DataArk.Cells(Row, Col), DataArk.Cells(RowSize, Col)).Find(DataArk.Cells(Row, 1)) ' After:=DataArk.Cells(Row - 1, Col), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            If foundRng Is Nothing Then
            ResArk.Activate
            ResArk.Cells(Row, Col + 1) = ""
            DataArk.Activate
            Else
            ResArk.Activate
            ResArk.Cells(Row, Col + 1) = foundRng.Address
            DataArk.Activate
            End If
        Next Row
   Next Col
End Sub