Need help with a macro to select all rows with yesterdays date

[Buns1976]

Hi Everyone,

I have a worksheet(Sheet1) with many rows of data that are presorted so that the most current date which is yesterday would start in Row 2(Row 1 is headers).
What I need is a macro that will SELECT ALL rows with yesterdays date([Today()-1]). The number of rows varies. It could be 3 yesterday and 4 today, etc.

From there I will need to copy the SELECTED rows and paste in Cell A1 in Sheet2.
The code below works but only selects the first row with yesterdays date.

Thanks for any help.
D



End Sub

Sub FindYesterdaysDateRow()

Dim Rng     As Range
Dim YesterD As Date

YesterD = DateAdd("d", -1, Date)
Set Rng = Range("A:A").Find(What:=YesterD, LookIn:=xlValues, LookAt:=xlWhole)

Range("A" & Rng.Row & ":V" & Rng.Row).Select

 

[kevin9999]

OK, this version is more robust. See where I've indicated where you can change the sheet names to whatever you want. Also includes an error trap if no records found for yesterday.

Option Explicit
Sub CopyYesterday2()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("SHIFT_IMPORT")    '<~~ Change the sheet names here
Set ws2 = Worksheets("SHIFT_EXPORT ")   '<~~ And here

    With ws1.Range("A1").CurrentRegion
        .AutoFilter 1, 2, 11
        If .Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A1")
        Else
            MsgBox "No records found for yesterday"
        End If
        .AutoFilter
    End With
End Sub

 

[Buns1976]

OK, this version is more robust. See where I've indicated where you can change the sheet names to whatever you want. Also includes an error trap if no records found for yesterday.

Option Explicit
Sub CopyYesterday2()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("SHIFT_IMPORT")    '<~~ Change the sheet names here
Set ws2 = Worksheets("SHIFT_EXPORT ")   '<~~ And here

    With ws1.Range("A1").CurrentRegion
        .AutoFilter 1, 2, 11
        If .Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A1")
        Else
            MsgBox "No records found for yesterday"
        End If
        .AutoFilter
    End With
End Sub

 

[Buns1976]

Perfect! Thanks for your help. Much Appreciated.

 

[kevin9999]

Perfect! Thanks for your help. Much Appreciated.

Glad we could help and thanks for the feedback