PDA

View Full Version : VBA Copy Last Row into Last Row on Another Workbook



Shawshank
01-03-2019, 09:34 AM
Hello All, :hi:

Really hope someone can help, been googling for what seems like days. :banghead:

I need VBA Code to Copy Last Row into Last Row on Another Workbook or preferably just append what has not already been copied to the destination then Save the Source Workbook
I plan to add a button to execute the code

The code below which I found somewhere copies the whole sheet, I can find code to copy from sheet to sheet but not another workbook? I would be most grateful for any help here

To test the code I have set up to Workbooks called "From" and "To" both with only one sheet called "Sheet1"

Public Sub copy_wb()
Dim copy_from As Range
Dim copy_to As Range

Set copy_from = Workbooks("Bookname").Worksheets("Sheetname").UsedRange
Set copy_to = Workbooks("Bookname").Worksheets("Sheetname").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

copy_from.Copy Destination:=copy_to
Application.CutCopyMode = False

End Sub

Rob342
01-03-2019, 04:28 PM
This should work change file names & location of To as required


Sub copy_wb()
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Mysheet As Worksheet
Dim FromlastRow As Long
Dim ToLastRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set DestWB = Workbooks.Open("C:\To.xlsx")
Set Mysheet = ThisWorkbook.Worksheets("Sheet1")
Set DestSh = DestWB.Worksheets("Sheet1")
FromlastRow = Mysheet.cells(Rows.Count, 1).End(xlUp).Row - 1
ToLastRow = DestSh.cells(Rows.Count, 1).End(xlUp).Row + 1
With Mysheet
'.Visible = True
.Activate
.Range("A" & FromlastRow).Copy _
Destination:=DestSh.Range("A" & ToLastRow)
'.Visible = xlVeryHidden
End With
Application.CutCopyMode = False
DestWB.Close savechanges:=True
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Shawshank
01-03-2019, 07:43 PM
Really glad I got a response here, thanks Rob342

Took me a while to figure out that I had the add the "End Sub" at the end :doh:

This works like a beute, nice and fast, opens, copies and saves the Dest file which is great but for some reason is only copying the contents of one cell, the A1 cell and not the whole row, also it's copying from the first row of the source file instead of the last and I can't seem to fix it. :think:

Possibly the "FromLastRow" and "ToLastRow" variables?

Sooo close, I can taste it!

Any ideas?

PS Thanks again for your speedy reply.

jolivanes
01-03-2019, 07:53 PM
Assumes, from looking at your code in Post #1, that the book you're pasting into is open.
Change it's name in the following code as required
It also does not paste "into Last Row" but below the last used cell in Column A.

Sub Maybe()
Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Resize(, Sheets("Sheet1").UsedRange.Columns.Count).Copy _
Workbooks("NameOfToBookHere.xlsm").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End Sub

Shawshank
01-03-2019, 08:25 PM
Thanks Jolivanes,

As it happens it's better for me to have the Destination file closed. I have gotten used to the idea of keeping it that way, less likely the users will get confused with which sheet they are working on :wot

I tried using the code you have posted, I got a "Subscript Out of Range" but I think I may have put the files names in incorrectly, I 'll give it another go tomorrow it's 3:30am and I'm getting sloppy :bug:

jolivanes
01-03-2019, 10:02 PM
Sub Maybe()
Dim lr As Long, lc As Long, wb1 As Workbook, sh1 As Worksheet, a
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
Set sh1 = wb1.Sheets("Sheet1")
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(lr, Columns.Count).End(xlToLeft).Column
a = Range(Cells(lr, 1), Cells(lr, lc)).Value
With Workbooks.Open("C:\Test\PasteIntoBook.xlsm").Sheets("Sheet1") '<---- Change as required
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, lc).Value = a
ActiveWorkbook.Close True
End With
Application.ScreenUpdating = True
End Sub

Rob342
01-04-2019, 01:50 AM
Shawshank
Does your sheet have extending columns when data is added or is it fixed?
I can take another look later or you can go with jolivanes
I do have a shorter bit of code but need to test before posting it
rob

Shawshank
01-04-2019, 03:34 AM
Jolivanes, this code works perfectly:clap:

Thanks again to you both, Jolivanes and Rob342 :bow: