Macro for cutting and pasting from one table to another table

RSLQA

New Member
Joined
Mar 17, 2014
Messages
14
Hello,

I have a worksheet with two tabs, each tab has one table. Tab "Main" has a table called "Current" and tab "Past30Days" has a table called "Old".

I need the macro to look in the "Date" column in the "Current" table and if the date is past 30 days from today to cut the row and paste/add it to the bottom of the "Old" table. It should also delete the empty rows left from cutting in the "Current" tab.

Any help is greatly appreciated. I am comfortable using the recorder and trimming down what I don't need but as I'm trying to get into the actual writing where the recorder can't help me, I've been getting stuck.

Thank you,
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
I forgot to mention I'm using Excel 2013.
This is the solution so far..

A coworker with much more experience than I was kind enough to create this for me. My issue now is that when it goes to paste the rows it does not put it into the table called "Old" it pastes it right beneath it so it is not part of the table.

Sub CutPastePast30()
'Delete rows if date put in the sheet is < today - 30
Dim n As Long
Dim LastRow As Integer
Dim DestinationRow As Integer

LastRow = Worksheets("Main").Range("A65536").End(xlUp).Row

For n = LastRow To 2 Step -1
If Worksheets("Main").Range("A" & n).Value < Date - 30 Then
Worksheets("Main").Range("A" & n & ":Y" & n).Copy
DestinationRow = Worksheets("Past30Days").Range("A65536").End(xlUp).Row + 1
ActiveSheet.Paste Destination:=Worksheets("Past30Days").Range("A" & DestinationRow)
Worksheets("Main").Range("A" & n & ":Y" & n).Delete xlUp
End If
Next n

End Sub
 
Upvote 0
Try this you will need to adjust the column for the date's to check against

Sub ApplyFilter1A()
'This is the second step to filter the data for the first 2 criteria
Sheets("Current").Select
'I have used Column number 4 as example
Range("A1").AutoFilter Field:=4, Criteria1:="<=" & CLng(Date - 30)
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Cut
Sheets("Past30Days").Activate
'I have used column A to go to bottom and then back up
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Range("a1").Activate
End Sub
 
Upvote 0
Thank you for taking the time to respond and I hope I'm doing this correctly.

Since the first part of the macro is working fine I didn't change it, but I used your code from after the cut action. It still will not put the cut rows into my table. The table called "Old" on the Past30Days sheet, has it's headers in row2 and row3 is part of the table but blank. Both ways still has the information pasting at row4 making it outside of the table. As a work around I was thinking of making it remove the table, do this macro and then remake it a table but I would like to avoid that if I can.

Sub CutPP30()
'test to make paste values only

'Delete rows if date put in the sheet is < today - 30
Dim n As Long
Dim LastRow As Integer

LastRow = Worksheets("Main").Range("A65536").End(xlUp).Row

For n = LastRow To 2 Step -1
If Worksheets("Main").Range("A" & n).Value < Date - 30 Then
Worksheets("Main").Range("A" & n & ":Y" & n).Copy
Sheets("Past30Days").Activate
'I have used column A to go to bottom and then back up
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Skipblanks:=False, Transpose:=False
Worksheets("Main").Range("A" & n & ":Y" & n).Delete xlUp
End If
Next n

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

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