Macro to copy data with a date criteria

[Guest]

Help is needed:

I have the following spreadsheet:

A b c d e
Crse1 01/08/07 08/08/07 16/08/07 23/08/07
Crse2 08/08/07 16/08/07 23/08/07 30/08/07
crse3 16/08/07 23/08/07 30/08/07 8/09/07

This is just a small part of the spreadsheet, it's about 300 rows and 40
columns.

I need the macro to copy all the data in each row into another spreadsheet
if the date in any of the colums matches a specific date, todays date as this
will be run on each day.

Eg todays date 08/08/07, so this would return the data in column A for rows
1 & 2 but not column 3.

Any help will be greatly appreciated.

Thanks

 

[Guest]

Try this code

Sub copydata()
Const OldSheet = "Sheet1"
Const NewSheet = "Sheet2"

NewSheetRow = 1
With Sheets(OldSheet)
LastCol = .Cells(1, Columns.Count). _
End(xlToLeft).Column

RowCount = 1
Do While (.Cells(RowCount, "A"). _
Value <> "")
Set RowRange = .Range(.Cells(RowCount, _
"B"), .Cells(RowCount, LastCol))
For Each cell In RowRange

If cell = Int(Now()) Then
.Rows(RowCount).Copy _
Destination:= _
Sheets(NewSheet). _
Rows(NewSheetRow)
NewSheetRow = NewSheetRow + 1
End If
Next cell
RowCount = RowCount + 1
Loop
End With
End Sub