Sub CopyRow()
Dim Rng As Range
Dim i As Range
Set Rng = Range("A15", Range("A" & Rows.Count).End(xlUp))
For Each i In Rng
If i = Date Then
i.EntireRow.Copy
With Sheets("History Stats")
Range(.[A3], .[A3].End(xlDown)).Offset(1).PasteSpecial xlPasteAll
End With
End If
Next i
End Sub