matching hour in one sheet to same hour in another sheet

[oakman]

I am trying to copy data depending on whether the hour of the day in sheet 1 matches the hour in sheet 2. Currently, the code below looks at contract numbers in TRANS SPECS sheet and finds that contract in sheet3 it then finds the same contract in Sheet DA-RT Flow. The macro copies a block of 24 cells indiscriminately. I was wandering if there is a way to match the hour in sheet3 with the hour in sheet DA-RT Flow once the contract has been found in both sheets. Thank you so much for any help provided!
Dim Contract As Variant
Dim Flow As Double

Application.ScreenUpdating = False
Application.DisplayAlerts = False


ThisFile = ThisWorkbook.Name
Contract = Sheets(1).Range("C22:C36")
PathName = Sheets(1).Range("C3").Value
Filename = Sheets(1).Range("C6").Value

'Copy CSV with RT flow from nMarket

Workbooks.Open Filename:=PathName & Filename
Windows(Filename).Activate

    Cells.Select
    Selection.Copy
    Windows(ThisFile).Activate
    Sheets(3).Select
    Cells.Select
    ActiveSheet.Paste
    Windows(Filename).Activate
    ActiveWindow.Close
    
'Update Day Ahead flow in the Flow spreadsheet

For Each Contract In Sheets(1).Range("C22:C36")

 If Contract = "" Then
    Sheets("TRANS SPECS").Activate
        Range("B34").Select
            Application.ScreenUpdating = True
    Exit Sub
 End If
   
Sheets(3).Activate
Range("A16").Select
    On Error GoTo BadContract
    Cells.Find(What:=Contract, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(0, 4).Range("A1:A24").Select
                Selection.Copy

Sheets("DA-RT Flow").Activate
Range("A1").Select
    Cells.Find(What:=Contract, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(3, 1).Activate
            Selection.PasteSpecial 'Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                'False, Transpose:=False
        
Next Contract
BadContract:
Sheets("TRANS SPECS").Activate
Range("B34").Select
Exit Sub

Application.ScreenUpdating = True
End Sub