Sorting columns and paste to new sheet if certain cells meet the criteria

I'm new to StackOverflow and kinda fresh in Excel VBA too, and I hope to find answers and eventually provide answers as well.

Here's my problem: Sheet 1 (Called "Disorderly") has a numerous numbers of values gathered from different sensors, stored in every other column. In the column to the left for each sensor value is the associated time stamp for every sensor value. See picture. Not every time stamp is the same, which causes trouble. I need to paste the values which have the same time stamp to a new sheet. My thoughts are two for loops searching through each column in search for the value in the first columns in each row. After trying and failing a bit, I went for the Range.Find function. I get a strange result and it took forever to search through. Is using the find-function even recommended inside a (two) for loop(s)? Anyone with a efficient and correct take on this problem? I would really appreciate any guidance and tips :) Little peak of data set

    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