Sub CopyData()
Dim rngDest As Range, rngFound As Range
Dim rngCopy As Range
Dim rngSource As Range
Dim varTime As Variant
Dim datTime As Date
Dim iRow As Integer
Dim bValid As Boolean
Set rngSource = ActiveWorkbook.Worksheets(1).UsedRange
With ActiveWorkbook.Worksheets(2)
Set rngFound = Intersect(.UsedRange.Offset(0, 1), .UsedRange)
If Not rngFound Is Nothing Then
rngFound.Delete (xlShiftToLeft)
End If
Set rngFound = Nothing
For iRow = 1 To .UsedRange.Rows.Count
varTime = .Cells(iRow, 1).Value
bValid = False
If Not IsNumeric(varTime) Then
If IsDate(varTime) Then
datTime = varTime
bValid = True
End If
Else
datTime = varTime
varTime = Format(datTime, "hh:nn:ss")
bValid = True
End If
If bValid Then
Set rngFound = rngSource.Columns(1).Find(varTime, LookIn:=xlValues)
If Not rngFound Is Nothing Then
Set rngFound = rngSource.Rows(rngFound.Row)
Set rngFound = Intersect(rngFound.Offset(0, 1), rngSource)
rngFound.Copy (.Cells(iRow, 2))
Set rngCopy = rngFound
Else
If Not rngCopy Is Nothing Then
rngCopy.Copy (.Cells(iRow, 2))
End If
End If
End If
VBA.DoEvents
Next
End With
End Sub