Option Explicit
Dim ws As Worksheet
Sub test()
Set ws = Worksheets("Sheet1")
CopyDown ws.Range("C1").Value
End Sub

Sub CopyDown(thisDate As Date)
Dim rw As Long
Dim found As Range
With Worksheets("Sheet2")
Set found = .Range("A:A").Find(thisDate)
If Not found Is Nothing Then
rw = found.Row
With .Range(.Cells(rw, 2), .Cells(rw, 1).End(xlDown).Offset(, 3))
.Value = WorksheetFunction.Transpose(ws.Range("A1:A3").Valu e)
End With
End If
End With
End Sub


"Kevin" wrote:

Can you please help me...
I am trying to create a macro to copy data from some cells and look up
today's date on a table and paste the info from this date onwards leaving the
previous information for past dates intact. I will be using a button to
start the macro.
e.g.
data
todays date (=today()) in a cell i.e. date = 03/01
A1 1
A2 2
A3 3

table
date column 1 column 2 column 3
01/01
02/01
03/01 1 2 3
04/01 1 2 3
05/01 1 2 3
and so on to end of table

Thanks
Kevin