Need VBA to automatically copy and paste entire row info to next sheet based on date

[MJ72]

I would like to develop a VBA that automatically copies entire row info from specific row on Sheet1 and pastes it into next available space in table on Sheet2 based on date info in column G (any row where date is older than 60 days/highlighted in red). Table in Sheet2 is virtually identical to Sheet1

 

[Joe4]

So, do you only want to copy the rows that are over 60 days old?
If so, then do you want to delete them from this first sheet after they are moved (so they won't be moved again the next time you run the VBA code)?

 

[MJ72]

So, do you only want to copy the rows that are over 60 days old?
If so, then do you want to delete them from this first sheet after they are moved (so they won't be moved again the next time you run the VBA code)?

Yes, I only want to auto-copy the ones that are over 60 days old but no, I do not want them to delete... I would rather that they replace the existing ones on sheet 2. Sheet1 gets updated daily, by someone else, with new entries, so I can't have the existing data be deleted. Sheet2 is what I want to use for me to target 60+ without having to filter Sheet1 all the time.

 

[Joe4]

So, do you want to then first blank out all records on Sheet2 first, and start over copying the records fresh each time?
That would avoid any duplication on Sheet2 (if a record was already copied over previously).

Note you could do this by automating the filters with VBA code (which would probably be more efficient then looping through row-by-row).

 

[MJ72]

So, do you want to then first blank out all records on Sheet2 first, and start over copying the records fresh each time?
That would avoid any duplication on Sheet2 (if a record was already copied over previously).

Note you could do this by automating the filters with VBA code (which would probably be more efficient then looping through row-by-row).

Ok. That makes sense. How would I go about doing that. I've tried IF statements on Sheet2 but that only goes so far and I'm a rookie, to say the least, at VBA.

 

[Joe4]

It looks you are using data tables. Assuming that assumption is correct, try this:

Sub MyCopyMacro()
    
    Dim crit As String
    Dim tbl As String
    
'   Delete current data on Sheet2
    Sheets("Sheet2").Activate
    Range("A1").CurrentRegion.Delete
    
'   Copy over data from Sheet1
    Sheets("Sheet1").Activate
    Range("A1").CurrentRegion.Copy
    Sheets("Sheet2").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
'   Get name of table just added to sheet 2
    tbl = Sheets("Sheet2").ListObjects(1).Name
    
'   Build crtieria row for 60 days in the past
    crit = "<" & Format(Date - 60, "m/d/yyyy")
    
'   Apply filter to table
    ActiveSheet.ListObjects(tbl).Range.AutoFilter Field:=7, Criteria1:=crit, Operator:=xlAnd
    
'   Delete hidden rows
    DeleteHiddenRows
    
End Sub


Public Sub DeleteHiddenRows()
    
    Dim lRows As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For lRows = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
    Next lRows
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

 

[MJ72]

It looks you are using data tables. Assuming that assumption is correct, try this:

Sub MyCopyMacro()
   
    Dim crit As String
    Dim tbl As String
   
'   Delete current data on Sheet2
    Sheets("Sheet2").Activate
    Range("A1").CurrentRegion.Delete
   
'   Copy over data from Sheet1
    Sheets("Sheet1").Activate
    Range("A1").CurrentRegion.Copy
    Sheets("Sheet2").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
'   Get name of table just added to sheet 2
    tbl = Sheets("Sheet2").ListObjects(1).Name
   
'   Build crtieria row for 60 days in the past
    crit = "<" & Format(Date - 60, "m/d/yyyy")
   
'   Apply filter to table
    ActiveSheet.ListObjects(tbl).Range.AutoFilter Field:=7, Criteria1:=crit, Operator:=xlAnd
   
'   Delete hidden rows
    DeleteHiddenRows
   
End Sub


Public Sub DeleteHiddenRows()
   
    Dim lRows As Long
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    For lRows = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
    Next lRows
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Ok...So that deleted the first table on Sheet1 and didn't copy/paste anything into Sheet2... may I email you a copy of the test workbook to make this a little easier?

 

[Joe4]

Ok...So that deleted the first table on Sheet1 and didn't copy/paste anything into Sheet2... may I email you a copy of the test workbook to make this a little easier?

That really shouldn't be possible.

This is the section of code that is doing the deleting:

'   Delete current data on Sheet2
    Sheets("Sheet2").Activate
    Range("A1").CurrentRegion.Delete

It is clearly activating Sheet2 before it does the deletion.
Do your sheet names match and are they in the correct order?

If you wish to share your file, you will need to upload it to some file sharing site (like DropBox, Google Drive, One Drive, etc) and provide a link to it here in this thread.

 

[MJ72]

Book2.xlsm

 

[Joe4]

OK, so it looks like you actually do NOT have any data in column A, and I assumed that you did (could not tell from your original image, as the first few columns were cut off).
Also, can you tell me if this data is actually in a table or not (for some reason, I do not see how to download your file to verify that).
From your original image, it looks like it is, but in viewing the workbook on line, I am not so sure anymore.

If it is a table, see if these changes work. If it is not a table, we probably have more work to do.

Sub MyCopyMacro()
    
    Dim crit As String
    Dim tbl As String
    
'   Delete current data on Sheet2
    Sheets("Sheet2").Activate
    Range("B1").CurrentRegion.Delete
    
'   Copy over data from Sheet1
    Sheets("Sheet1").Activate
    Range("B1").CurrentRegion.Copy
    Sheets("Sheet2").Activate
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
'   Get name of table just added to sheet 2
    tbl = Sheets("Sheet2").ListObjects(1).Name
    
'   Build crtieria row for 60 days in the past
    crit = "<" & Format(Date - 60, "m/d/yyyy")
    
'   Apply filter to table
    ActiveSheet.ListObjects(tbl).Range.AutoFilter Field:=6, Criteria1:=crit, Operator:=xlAnd
    
'   Delete hidden rows
    DeleteHiddenRows
    
End Sub


Public Sub DeleteHiddenRows()
    
    Dim lRows As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For lRows = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
    Next lRows
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub