Copy all rows with a date equal to today or yesterday to another sheet named 'Final'

[jhgiants95]

I am looking to copy and paste as values (due to formulas) all rows whose column A has a date equal to today or yesterday. This report is run at the end of each day and needs to have certain information from the past two days. Both sheets have the same columns and format. The paste should begin in row 2 column A of the sheet "Final".

The sheet that will copy the data over is called "Input". Thanks for any help or guidance as I could not figure out based on searching how to do this.

The columns in the final sheet have been formatted properly so everything should be correct in the result sheet.

 

[sheetspread]

The advanced filter will do this

 

[jhgiants95]

Can you please explain. I don't believe that I can select two dates for this. There is quite a bit of data here so I cannot simply browse through a sorted list and copy it on my own. Thanks.

 

[sheetspread]

Excel 2010
	A	B	C	D	E	F	G	H	I	J	K
1	Name	Date	Number						Name	Date	Number
2	ABC	1/23/2018	92							1/26/2018
3	ABC	1/25/2018	51							1/25/2018
4	ABC	1/26/2018	4
5	ABC	1/27/2018	5
6	ABC	1/29/2018	20
7	ABC	1/30/2018	36
8	ABC	2/1/2018	91
9	ABC	2/2/2018	62
10	ABC	2/5/2018	14
11	ABC	2/5/2018	45
12	ABC	1/26/2018	81
13	ABC	2/8/2018	15
14	TDS	1/10/2018	29
15	TDS	1/27/2018	51
16	TDS	2/14/2018	97
17	TDS	1/25/2018	97
18	TDS	3/14/2018	40
Input

Cell Formulas
Range	Formula
J2	=TODAY()
J3	=TODAY()-1

Excel 2010
	A	B	C
1	Name	Date	Number
2	ABC	1/25/2018	51
3	ABC	1/26/2018	4
4	ABC	1/26/2018	81
5	TDS	1/25/2018	97
Final

Remember to open the advanced filter from the destination sheet

 

[My Aswer Is This]

Try this:

Sub Copy_Today_Yesterday()
'Modified 1-26-18 7:25 PM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
ansT = DateAdd("d", 0, Date)
ansY = DateAdd("d", -1, Date)
Sheets("Final").Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    With Range("A1:A" & Lastrow)
       .AutoFilter Field:=1, Criteria1:=ansT, Operator:=xlOr, Criteria2:=ansY
        .Offset(1).EntireRow.Copy
        Sheets("Input").Range("A2").PasteSpecial xlPasteValues
        .AutoFilter
    End With
Application.ScreenUpdating = True
End Sub