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

MJ72

Board Regular
Joined
Aug 17, 2021
Messages
64
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

1631635153161.png
 
Here is another version of code that I think will work, regardless of whether the data is in a table or not:
VBA Code:
Sub MyCopyMacro2()

    Dim lr1 As Long
    Dim r As Long
    Dim lr2 As Long
    Dim nr As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data on sheet 2
    lr2 = Sheets("Sheet2").Cells(Rows.Count, "G").End(xlUp).Row
    
'   Delete rows from sheet 2
    If lr2 > 1 Then Sheets("sheet2").Rows("2:" & lr2).Delete
    
'   Initialize first blank row number variables
    nr = 2
    
'   Find last row with data on sheet 1
    lr1 = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row
    
'   Loop through each row of data
    For r = 2 To lr1
'       See if date in column G is more than 60 days old
        If (Date - Sheets("Sheet1").Cells(r, "G")) > 60 Then
'           Copy to sheet2
            Sheets("Sheet1").Rows(r).Copy Sheets("Sheet2").Cells(nr, "A")
'           Increment new row counter
            nr = nr + 1
        End If
    Next r
    
    Application.ScreenUpdating = True

End Sub
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Here is another version of code that I think will work, regardless of whether the data is in a table or not:
VBA Code:
Sub MyCopyMacro2()

    Dim lr1 As Long
    Dim r As Long
    Dim lr2 As Long
    Dim nr As Long
  
    Application.ScreenUpdating = False
  
'   Find last row with data on sheet 2
    lr2 = Sheets("Sheet2").Cells(Rows.Count, "G").End(xlUp).Row
  
'   Delete rows from sheet 2
    If lr2 > 1 Then Sheets("sheet2").Rows("2:" & lr2).Delete
  
'   Initialize first blank row number variables
    nr = 2
  
'   Find last row with data on sheet 1
    lr1 = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row
  
'   Loop through each row of data
    For r = 2 To lr1
'       See if date in column G is more than 60 days old
        If (Date - Sheets("Sheet1").Cells(r, "G")) > 60 Then
'           Copy to sheet2
            Sheets("Sheet1").Rows(r).Copy Sheets("Sheet2").Cells(nr, "A")
'           Increment new row counter
            nr = nr + 1
        End If
    Next r
  
    Application.ScreenUpdating = True

End Sub
Good Morning Joe,
Sorry for the delayed response, work has been insane. So I've tried both codes... first one deleted the first table but did not copy it over, the second just deleted the second table and gave a run time error. As for not being able to download the file, does it help if I told you that it was shared via Google Drive?.... and Sheet2 has now been formatted as a table. Here's a Dropbox link, maybe it'll be easier to open...
 
Upvote 0
What is the name of the VBA module where you have placed this code?
 
Upvote 0
MyCopyMacro - Sheet1
I think that is your issue right there. Since your code spans mutliple sheets, do not put it in the "Sheet1" module.
Insert your own module (and it will be named something like "Module1"), and then it will be generic and can be referenced by all sheets in your workbook.
 
Upvote 0
I think that is your issue right there. Since your code spans mutliple sheets, do not put it in the "Sheet1" module.
Insert your own module (and it will be named something like "Module1"), and then it will be generic and can be referenced by all sheets in your workbook.
Just tried that after you asked figuring that's where the conversation was headed and still no result, just a run time error.
 
Upvote 0
just a run time error.
What exactly does the run-time error say?
Does it give you a "Debug" option, and if it does, what line does it highlight?

When when you copied the code over to a general module, did you delete it from the Sheet module?
 
Upvote 0
What exactly does the run-time error say?
Does it give you a "Debug" option, and if it does, what line does it highlight?

When when you copied the code over to a general module, did you delete it from the Sheet module?
Yes, I deleted it from the sheet. Lol. Run-time error '1004' Delete method of Range class failed...Debug...line 5 "Range("A1").CurrentRegion.Delete"
 
Upvote 0
Yes, I deleted it from the sheet. Lol. Run-time error '1004' Delete method of Range class failed...Debug...line 5 "Range("A1").CurrentRegion.Delete"
That does not appear to be from either of the two latest versions of code that I posted, but rather from the first one, when I throught you had data in column A (which we later found out is not the case).

Try the newer versions of the code, not the original code.
 
Upvote 0
That does not appear to be from either of the two latest versions of code that I posted, but rather from the first one, when I throught you had data in column A (which we later found out is not the case).

Try the newer versions of the code, not the original code.
There will be data in the other columns.
 
Upvote 0

Forum statistics

Threads
1,214,920
Messages
6,122,269
Members
449,075
Latest member
staticfluids

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top