Select Rows before today & Copy PasteValue Numbers

[bcurrey]

I have a spreadsheet that summarizes basic inbound/outbound numbers each day. Columns B&C are COUNTIFS off of a SQL table on a separate tab. The SQL code only keeps the most recent 7 days of data stored in the workbook.

I need VBA that will select the row prior to today, Copy & PasteValues so that the numbers don't get lost after 7 days pass.

Any ideas? Thanks!



[TABLE="width: 360"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Keyed[/TD]
[TD]Receipts[/TD]
[TD]# to key[/TD]
[/TR]
[TR]
[TD]4/25/2018[/TD]
[TD]315[/TD]
[TD]1245[/TD]
[TD]930[/TD]
[/TR]
[TR]
[TD]4/26/2018[/TD]
[TD]540[/TD]
[TD]356[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]4/27/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]4/30/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/1/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/2/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/3/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/4/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/7/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/8/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/9/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/10/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/11/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/14/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/15/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
[TR]
[TD]5/16/2018[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]746[/TD]
[/TR]
</tbody>[/TABLE]

 

[alansidman]

try this

  Sub SavePrior()    Dim s1 As Worksheet, s2 As Worksheet
    Dim lr As Long, lr2 As Long, i As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("A" & i) < Date Then
            s1.Range("A" & i & ":D" & i).Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Action Complete"
End Sub

 

[bcurrey]

Awesome Alan! It works perfect. I really appreciate it!!

try this

  Sub SavePrior()    Dim s1 As Worksheet, s2 As Worksheet
    Dim lr As Long, lr2 As Long, i As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("A" & i) < Date Then
            s1.Range("A" & i & ":D" & i).Copy
            s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Action Complete"
End Sub