Archive macro

[SoupVictim]

Hi all,

I have been looking around but i cannot quite find something that fits what i need. Let me explain.

I need to copy all rows and data from a table (table1) in a worksheet and paste them at the end of another table (table2) in another worksheet in the same workbook. But i would like the rows and data that are pasted into (table2) to have the first column in each row auto filled with todays date. As you can see i hope to create an archive type table of data. After pasting the data into (table2) i require columns 2 and 3 in (table1) to be emptied.

I hope that all makes sense and is not to tricky.

Any help is most appreciated.

 

[DutchDiggy]

Can you provide:

* Sheetname from
* Sheetname to
* Range of data sheetname from
* Are there headers included in that range?

 

[SoupVictim]

Sheetname from = worksheet1
Sheetname to = worksheet2
range of data = can this be the name of the table to encompass all data in a dynamic table? (may have more rows sometimes) if so then its table1.
headers = no headers, both tables have the same columns except table2 will have an extra first column which will be auto filled with todays date.

 

[DutchDiggy]

Sub archive()
Dim LastArchive As Integer
LastArchive = ThisWorkbook.Sheets("Worksheet2").Cells(1, 1).End(xlDown).Row
 If LastArchive = 2 Then LastArchive = 1
 
 ThisWorkbook.Sheets("worksheet1").Range("Table1").Copy _
 Destination:=Sheets("Worksheet2").Range("A" & LastArchive + 1).Offset(0, 1)
 
Dim LastNewEntry As Integer
LastNewEntry = ThisWorkbook.Sheets("Worksheet2").Cells(1, 2).End(xlDown).Row


 ThisWorkbook.Sheets("worksheet2").Range("A" & LastArchive + 1 & ":A" & LastNewEntry).Value = Date


ThisWorkbook.Sheets("Worksheet1").Range("Table1").ClearContents




End Sub

Maybe this will be sufficient to your needs.

 

[SoupVictim]

Thanks so much. I will give it a try later and let you know how it goes.