Copy, Search, Then Paste Needed

If there is a fixed interval between your two sets of dates:

Sub Copy()

Dim rDates As Range, r As Long

With Sheet2
    Set rDates = .Range("A1", .Range("A1").End(xlDown))
    On Error GoTo errline
    r = WorksheetFunction.Match(Range("A1"), rDates, 0)
    On Error Resume Next
    .Cells(r, 2).Resize(, 4).Value = Range("B1:E1").Value
    .Cells(r + 33, 2).Resize(, 4).Value = Range("B2:E2").Value
End With

Exit Sub

errline: MsgBox Range("A1") & " not found"

End Sub