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

sal1234

New Member
Joined
Sep 5, 2014
Messages
6
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
 
Last edited:

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,110
Office Version
  1. 365
Platform
  1. Windows
This line is wrong:

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

How many sheets does archivesheet.xlsx have?
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,110
Office Version
  1. 365
Platform
  1. Windows
Sorry yes just seen Sheet1. Try this:

Code:
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

New Member
Joined
Sep 5, 2014
Messages
6
Sorry yes just seen Sheet1. Try this:

Code:
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!!!
 

Watch MrExcel Video

Forum statistics

Threads
1,108,917
Messages
5,525,621
Members
409,657
Latest member
19JimRon72

This Week's Hot Topics

Top