Giúp code Nạp dữ liệu vào File đóng ( hỏi lần 2 ) (1 người xem)

[minhtuan55]

Chào cả nhà GPE ! Kính chúc cả nhà năm mới 2017
Em có 1 vấn đề mà em viết code hoài không được. Em có 2 file excel

banhang.xls File này dùng để mở lên bán hàng ( thường xuyên mở )
Data.xls File này dùng để lưu dữ liệu ( thường xuyên đóng )

Em muốn khi em bấm vào nút Bấm ghi dử liệu ở File Banhang thì dữ liệu sẽ nạp vào file data , mà file data không cần mở lên ( mà có mở lên cũng không sao )
em có gửi 2 File mong các bác giúp em. Em xin chân thành cảm ơn !

 

[quanluu]

Chào cả nhà GPE ! Kính chúc cả nhà năm mới 2017
Em có 1 vấn đề mà em viết code hoài không được. Em có 2 file excel

banhang.xls File này dùng để mở lên bán hàng ( thường xuyên mở )
Data.xls File này dùng để lưu dữ liệu ( thường xuyên đóng )

Em muốn khi em bấm vào nút Bấm ghi dử liệu ở File Banhang thì dữ liệu sẽ nạp vào file data , mà file data không cần mở lên ( mà có mở lên cũng không sao )
em có gửi 2 File mong các bác giúp em. Em xin chân thành cảm ơn !

Sub copynew()
    Dim wbmain As Workbook, wb As Workbook
    Application.ScreenUpdating = False
    Set wbmain = ThisWorkbook
    Set wb = Workbooks.Open(wbmain.Path & "\data.xls")
    wbmain.ActiveSheet.Range("A3:D3").Copy wb.Sheets("data").Range("A" & wb.Sheets("data").Range("A65000").End(3).Row + 1)
    wb.Close True
    Application.ScreenUpdating = True
End Sub

 

[minhtuan55]

Sub copynew()
    Dim wbmain As Workbook, wb As Workbook
    Application.ScreenUpdating = False
    Set wbmain = ThisWorkbook
    Set wb = Workbooks.Open(wbmain.Path & "\data.xls")
    wbmain.ActiveSheet.Range("A3:D3").Copy wb.Sheets("data").Range("A" & wb.Sheets("data").Range("A65000").End(3).Row + 1)
    wb.Close True
    Application.ScreenUpdating = True
End Sub

dạ thank a. Anh ơi em muốn dùng thuộc tính Value =value , chứ thuộc tính copy em sợ tốn bộ nhớ Ram và chậm, anh sửa lại giúp em

 

[HieuCD]

dạ thank a. Anh ơi em muốn dùng thuộc tính Value =value , chứ thuộc tính copy em sợ tốn bộ nhớ Ram và chậm, anh sửa lại giúp em

dùng thử code

Sub copynew()
  Dim Arr()
  Application.ScreenUpdating = False
  Arr = Range("a3:d3").Value
  Workbooks.Open (ThisWorkbook.Path & "\data.xls")
  Sheets("data").Range("A50000").End(xlUp).Offset(1).Resize(, 4) = Arr
  ActiveWorkbook.Close True
  Application.ScreenUpdating = True
  Erase Arr
End Sub

 

[Hai Lúa Miền Tây]

Bạn mở nhiều đề tài với nội dung tương tự. Vì vậy tôi khóa đề tài này lại. Bạn nên tiếp tục với đề tài cũ nhé.