Help with Macro VBA - copying cells to another workbook without overwriting

[sal1234]

Hello,

Please could you help me, i am trying to create an archive macro which will take all rows in the sheet entered and are copied to the archive workbook, i was previously able to make it work to copy however it would overwrite the archive data from before in the archive sheet. Now it doesn't work at all, please could someone kindly assist? i am an adept at VBA so not sure what i've done wrong.

The rows contain data from column A to M, that is what needs to be copied into another workbook. The data required starts from row 5 in WB1, as top are headings and dates.


Sub ArchivingMonday()
'
' ArchivingMonday Macro
'
'
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim lastRow As Long
Set WB1 = ActiveWorkbook
Set WB2 = Workbooks.Open(WB1.Path & "\archivesheet.xlsx")
With WB1.Sheets("Mon")
'LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
lastRow = .Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copy the values
WB2.Sheets("Sheet1").Range("A2" & lastRow + 1).Value = .Range("A5" & lastRow).Value
End With
WB2.Save
WB2.Close
End Sub

 

[steve the fish]

This line is wrong:

WB2.Sheets("Sheet1").Range("A2" & lastRow + 1).Value = .Range("A5" & lastRow).Value

How many sheets does archivesheet.xlsx have?

 

[sal1234]

There is only 1 sheet in the archive workbook

 

[steve the fish]

Sorry yes just seen Sheet1. Try this:

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lr1 As Long
Dim lr2 As Long
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Mon")
Set wb2 = Workbooks.Open(wb1.Path & "\archivesheet.xlsx")
Set ws2 = wb2.Sheets("Sheet1")
lr1 = ws1.Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lr2 = ws2.Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ws1.Range("A5:M" & lr1).Copy
ws2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
wb2.Close True

You could name the variables as something more meaningful should you need to.

 

[sal1234]

Sorry yes just seen Sheet1. Try this:

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lr1 As Long
Dim lr2 As Long
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Mon")
Set wb2 = Workbooks.Open(wb1.Path & "\archivesheet.xlsx")
Set ws2 = wb2.Sheets("Sheet1")
lr1 = ws1.Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lr2 = ws2.Range("A:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ws1.Range("A5:M" & lr1).Copy
ws2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
wb2.Close True

You could name the variables as something more meaningful should you need to.

works perfectly, thank you very much for your help!!!