Copy sheet theo điều kiện

Liên hệ QC

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆
Tham gia
17/12/10
Bài viết
2,484
Được thích
2,949
Giới tính
Nam
Chào các Anh chị, Thầy cô trên diễn đàn
Hiện tại em đang muốn copy sheet từ 1 file khác theo đường dẫn có sẵn về file hiện tại như hình vẽ
1582007690254.png
Nhờ các thầy cô giúp ạ. Em xin cám ơn
Lí do là em có đọc về FileSystemObject nhưng vẫn không hiểu ạ
 

File đính kèm

  • NVL MT.xlsb
    10.3 KB · Đọc: 11
  • 202002ODRO02.XLS
    41.5 KB · Đọc: 6
Lần chỉnh sửa cuối:
Chào các Anh chị, Thầy cô trên diễn đàn
Hiện tại em đang muốn copy sheet từ 1 file khác theo đường dẫn có sẵn về file hiện tại như hình vẽ
View attachment 232109
Nhờ các thầy cô giúp ạ. Em xin cám ơn
Lí do là em có đọc về FileSystemObject nhưng vẫn không hiểu ạ
Hình như thiếu cái đuôi file cần lấy hay sao ấy.
 
Upvote 0
Bạn tham khảo gợi ý này nhé, mình mới học VBA vài ngày
Cám ơn anh đã giúp đỡ ạ. Em có tham khảo code trong file anh đính kèm. Nhưng mà nó đang lấy dữ liệu trên cùng foder sao ấy. Em muốn dựa vào điều kiện như hình ảnh để copy. (Lý do vì mỗi tháng nó bị thay đổi đường dẫn) ạ
 
Upvote 0
Cám ơn anh đã giúp đỡ ạ. Em có tham khảo code trong file anh đính kèm. Nhưng mà nó đang lấy dữ liệu trên cùng foder sao ấy. Em muốn dựa vào điều kiện như hình ảnh để copy. (Lý do vì mỗi tháng nó bị thay đổi đường dẫn) ạ

Sub copy_to_sheet()
ThisWorkbook.Worksheets("Out").Range("A6:M55").ClearContents
GetData ThisWorkbook.Path & "\202002ODRO02.xls", "WORK", _
"A1:AD77", Sheets("Out").Range("A1"), False, False
End Sub


Thay đổi đoạn text "ThisWorkbook.Path" ở trên thành đường dẫn lưu file "202002ODRO02" của bạn là xong
Bài đã được tự động gộp:

Nếu bạn muốn tự chọn file cần lấy dữ liệu bất kì thì tham khảo các cách ở đây và nghiên cứu thêm nhé
 

File đính kèm

  • ado.zip
    24.4 KB · Đọc: 10
Lần chỉnh sửa cuối:
Upvote 0
@rubia em đã thử file của anh khi đưa dữ liệu thật vào
khi xong rồi. tất cả các cell đều ở dạng text. có cách nào khắc phục cái này không thế ạ các thầy cô, anh chị?
 
Upvote 0
@rubia em đã thử file của anh khi đưa dữ liệu thật vào
khi xong rồi. tất cả các cell đều ở dạng text. có cách nào khắc phục cái này không thế ạ các thầy cô, anh chị?
Hình như là cái thuộc tính IMEX ở ADO nó quy định hay sao ấy.Cái này mình cũng không rõ lắm lâu rồi không dùng.
 
Upvote 0
Upvote 0
Copy Sheet tức là copy cả cái sheet, hay chỉ copy dữ liệu trong sheet đó?
 
Upvote 0
Copy Sheet tức là copy cả cái sheet, hay chỉ copy dữ liệu trong sheet đó?
Mục đích ban đầu của cháu là copy cả cái sheet đó sang file mới ạ. Vì lấy dữ liệu như các anh chị hộ trợ. Nó bị lỗi giá trị thành text hết mà cháu chưa biêt làm thế nào. vì khi copy về file mới. còn phải thao tác với cái sheet ấy ạ
 
Upvote 0
Mục đích ban đầu của cháu là copy cả cái sheet đó sang file mới ạ. Vì lấy dữ liệu như các anh chị hộ trợ. Nó bị lỗi giá trị thành text hết mà cháu chưa biêt làm thế nào. vì khi copy về file mới. còn phải thao tác với cái sheet ấy ạ
Mục đích bạn copy sheets đó làm gì vậy.
 
Upvote 0
Mục đích bạn copy sheets đó làm gì vậy.
Bên cty em có dùng phần mềm AS400. Cái file đó là file phần mềm xuất ra. Được yêu cầu là ko được vào đường dẫn trên. Vì lỡ cut về sẽ gây lỗi. Mà em vào thao tác thủ công thì có khả năng sẽ phát sinh vấn đề. Nên em muốn dùng VBA để tự động bật file đó và copy sheet ấy về. Xong tắt file đó đi không lưu ấy ạ. Khi copy rồi. Dữ liệu trong ấy em có sử dụng để tính toán.
Cụ thể hơn là do em làm kế hoạch sản xuất. File đó là toàn bộ dữ liệu đơn hàng ấy ạ
 
Upvote 0
Thôi thì dùng cách "cần cù" đi.

B1, B2, B3 là tên thư mục, tên tập tin (bỏ định dạng XLS) và tên sheet

1. Mỗi lần chạy code thì xóa sheet WORK cũ.
Mã:
Sub copysheet()
Dim path As String, filename As String, sheetname As String
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Home")
        path = .Range("B1").Value
        filename = .Range("B2").Value
        sheetname = .Range("B3").Value
    End With
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("WORK").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    With Workbooks.Open(path & "\" & filename & ".xls")
        .Worksheets("WORK").Copy ThisWorkbook.Worksheets("Home")
        .Close
    End With
    Application.ScreenUpdating = True
End Sub
2. Mỗi lần chạy code thì đổi tên sheet mới thành dạng "nămngàythánggiờphútgiây"
Mã:
Sub copysheet()
Dim path As String, filename As String, sheetname As String
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Home")
        path = .Range("B1").Value
        filename = .Range("B2").Value
        sheetname = .Range("B3").Value
    End With
    With Workbooks.Open(path & "\" & filename & ".xls")
        .Worksheets("WORK").Copy ThisWorkbook.Worksheets("Home")
        .Close
    End With
    ActiveSheet.Name = Format(Now(), "yyyymmddhhmmss")
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Bên cty em có dùng phần mềm AS400. Cái file đó là file phần mềm xuất ra. Được yêu cầu là ko được vào đường dẫn trên. Vì lỡ cut về sẽ gây lỗi. Mà em vào thao tác thủ công thì có khả năng sẽ phát sinh vấn đề. Nên em muốn dùng VBA để tự động bật file đó và copy sheet ấy về. Xong tắt file đó đi không lưu ấy ạ. Khi copy rồi. Dữ liệu trong ấy em có sử dụng để tính toán.
Cụ thể hơn là do em làm kế hoạch sản xuất. File đó là toàn bộ dữ liệu đơn hàng ấy ạ
"cut" về là cái gì?

Vấn đề này thuộc về chủ của cái file kia. Người chủ phải tự bảo vệ file của mình bằng cách chỉ cho "read only".

Thực ra, Microsoft đã thông qua vấn đề truy cập dữ liệu từ sheet khác này vào kỹ thuật Data Model và Power Query của Excel 2016 (2010-2013 thì cần cài thêm)
 
Upvote 0
Chung quy chỉ là do chủ file không bảo vệ nó bằng cách chỉ cho phép "read only".
Dùng VBA mở nó ra rồi sửa thì cũng chết thôi.

Chú: tôi ở đây đủ lâu để biết một khi đã lên đây thì tất cả chủ thớt đều khăng khăng là chỉ có phương án của mình là hoàn hảo, chỉ thiếu phần code thôi.
Những phương cách đề nghị đều sẽ được chủ thớt bác bỏ với câu "nhưng mà trường hợp của em..."
Vì vậy, điều tôi đưa ra ở bài #16 trên chỉ là để ý kiến cho các bạn khác.
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom