Copy Data from 1 workbook to another workbook and paste it below

[gerio24]

Hi Guys, need help in copying data from 1 workbook and paste it in another workbook but in the bottom area.

From Branch Sales person Series Date ALB Emelito Esteban 11013 01/31/18 ALB Jan Michael Raymundo 11014 01/31/18 ALB Jan Michael Raymundo 11014 01/31/18 ALB Jan Michael Raymundo 11014 01/31/18 <colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody> </tbody>

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

To
Branch	Sales person	Series	Date
CBO	Emelito Esteban	11013	01/31/18
CBO	Jan Michael Raymundo	11014	01/31/18
CBO	Jan Michael Raymundo	11014	01/31/18
CBO	Jan Michael Raymundo	11014	01/31/18
ALB	Emelito Esteban	11013	01/31/18
ALB	Jan Michael Raymundo	11014	01/31/18
ALB	Jan Michael Raymundo	11014	01/31/18
ALB	Jan Michael Raymundo	11014	01/31/18

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[frank_AL]

gerio,

what is the name of each Workbook and then the name of the Worksheet in each Workbook where data is copied from and then to?
Are both Workbooks open or do I need to check to see if the 'Copy To' Workbook is Open and then open it if it is not open?
Is the data shown above in Columns A through D?

 

[gerio24]

gerio,

what is the name of each Workbook and then the name of the Worksheet in each Workbook where data is copied from and then to?
Are both Workbooks open or do I need to check to see if the 'Copy To' Workbook is Open and then open it if it is not open?
Is the data shown above in Columns A through D?

The workbook where data will copied is come from different workbook but worksheet named is fixed to "Sheet2" and the workbook where the data will be pasted is named Daily Sales and worksheet name is EBT. Thanks in advanced.

 

[frank_AL]

gerio, give this code a try and let me know if you have any issues.

Option Explicit
Sub CopyComplete()
Dim CFwb As Workbook
Dim CFws As Worksheet
Dim CTwb As Workbook
Dim CTws As Worksheet
Dim CFfn As String
Dim CTfn As String
Dim CFlr As Long
Dim CTlr As Long
Dim CTRow As Long
Dim xRet As Boolean
Dim filepath As String


Set CFwb = ThisWorkbook
filepath = "C:\"


'  Check to see if Daily Sales file is open, if not Open the file
xRet = IsWorkBookOpen("Daily Sales.xlsx")
If xRet Then
    Set CTwb = Workbooks("Daily Sales.xlsx")
Else
    Set CTwb = Workbooks.Open(filepath & "Daily Sales.xlsx")
End If


Set CFws = CFwb.Sheets("Sheet2")
Set CTws = CTwb.Sheets("EBT")


'   Determine last rows in both Workbooks
    CFlr = CFws.Cells(CFws.Rows.Count, "B").End(xlUp).Row
    CTlr = CTws.Cells(Rows.Count, "B").End(xlUp).Row
    CTRow = CTlr + 1
    
'   Copy Data
CTws.Range("A" & CTRow & ":D" & (CTRow + (CFlr - 2))).Value = CFws.Range("A2:D" & CFlr).Value


End Sub


Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

 

[gerio24]

gerio, give this code a try and let me know if you have any issues.

option explicit
sub copycomplete()
dim cfwb as workbook
dim cfws as worksheet
dim ctwb as workbook
dim ctws as worksheet
dim cffn as string
dim ctfn as string
dim cflr as long
dim ctlr as long
dim ctrow as long
dim xret as boolean
dim filepath as string


set cfwb = thisworkbook
filepath = "c:\"


'  check to see if daily sales file is open, if not open the file
xret = isworkbookopen("daily sales.xlsx")
if xret then
    set ctwb = workbooks("daily sales.xlsx")
else
    set ctwb = workbooks.open(filepath & "daily sales.xlsx")
end if


set cfws = cfwb.sheets("sheet2")
set ctws = ctwb.sheets("ebt")


'   determine last rows in both workbooks
    cflr = cfws.cells(cfws.rows.count, "b").end(xlup).row
    ctlr = ctws.cells(rows.count, "b").end(xlup).row
    ctrow = ctlr + 1
    
'   copy data
ctws.range("a" & ctrow & ":d" & (ctrow + (cflr - 2))).value = cfws.range("a2:d" & cflr).value


end sub


function isworkbookopen(name as string) as boolean
    dim xwb as workbook
    on error resume next
    set xwb = application.workbooks.item(name)
    isworkbookopen = (not xwb is nothing)
end function

thank you very much sir!