Copy Last Row and Paste as last record
 

I have 2 spreadsheet (A & B) with same column headings. I am trying to put a
macro button in Spreadsheet A in which it will
1. copy the last row of data in Spreadsheet A
2. paste the row of data as last record (first empty row) in Spreadsheet B

The following is my codes, but it I can't get it to work, could someone help?

Dim lRow As Long

Dim Wb1 As Workbook
Dim Wb2 As Workbook

Dim WS1 As Worksheet
Dim WS2 As Worksheet

Application.ScreenUpdating = False

Set Wb1 = ActiveWorkbook
Set Wb2 = Workbooks.Open("S:\Stardex Compliance\Registers\Stardex Breach
Register.xls")

Set WS1 = Wb1.Worksheets("Register")
Set WS2 = Wb2.Worksheets("Register")

'find and copy last row in register 1
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
..LastRow.Copy
End With

'find the first empty row in register 2
lRow = WS2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
..Range(lRow, "A").PasteSpecial Paste:=xlAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Wb2.Save
Wb2.Close


Thanks

Copy Last Row and Paste as last record
 

One way:

Const csFILEPATH As String = _
"S:\Stardex Compliance\Registers\Stardex Breach Register.xls"
Dim wbDest As Workbook
Dim rDest As Range
Dim rSource As Range

With ActiveWorkbook.Worksheets("Register")
Set rSource = .Cells(.Rows.Count, 1).End(xlUp)
End With
Set wbDest = Workbooks.Open(csFILEPATH)
With wbDest.Sheets("Register")
rSource.EntireRow.Copy _
Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
wbDest.Close SaveChanges:=True

In article ,
Sin wrote:

I have 2 spreadsheet (A & B) with same column headings. I am trying to put a
macro button in Spreadsheet A in which it will
1. copy the last row of data in Spreadsheet A
2. paste the row of data as last record (first empty row) in Spreadsheet B

The following is my codes, but it I can't get it to work, could someone help?

Dim lRow As Long

Dim Wb1 As Workbook
Dim Wb2 As Workbook

Dim WS1 As Worksheet
Dim WS2 As Worksheet

Application.ScreenUpdating = False

Set Wb1 = ActiveWorkbook
Set Wb2 = Workbooks.Open("S:\Stardex Compliance\Registers\Stardex Breach
Register.xls")

Set WS1 = Wb1.Worksheets("Register")
Set WS2 = Wb2.Worksheets("Register")

'find and copy last row in register 1
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.LastRow.Copy
End With

'find the first empty row in register 2
lRow = WS2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Range(lRow, "A").PasteSpecial Paste:=xlAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Wb2.Save
Wb2.Close


Thanks

Copy Last Row and Paste as last record
 

Or, a bit more efficiently:

Const csFILEPATH As String = _
"S:\Stardex Compliance\Registers\Stardex Breach Register.xls"
Dim rSource As Range

With ActiveWorkbook.Worksheets("Register")
Set rSource = .Cells(.Rows.Count, 1).End(xlUp)
End With
With Workbooks.Open(csFILEPATH)
With .Sheets("Register")
rSource.EntireRow.Copy _
Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
.Close SaveChanges:=True
End With

In article ,
JE McGimpsey wrote:

One way:

Const csFILEPATH As String = _
"S:\Stardex Compliance\Registers\Stardex Breach Register.xls"
Dim wbDest As Workbook
Dim rDest As Range
Dim rSource As Range

With ActiveWorkbook.Worksheets("Register")
Set rSource = .Cells(.Rows.Count, 1).End(xlUp)
End With
Set wbDest = Workbooks.Open(csFILEPATH)
With wbDest.Sheets("Register")
rSource.EntireRow.Copy _
Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
wbDest.Close SaveChanges:=True