Copy sang các file trong các thư mục khác nhau

[hongphuong1997]

Cháu nhờ các Bác và Anh chị giúp cháu bài như file đính kèm ạ
Cháu cảm ơn ạ

 

[BuiQuangThuan]

Cháu nhờ các Bác và Anh chị giúp cháu bài như file đính kèm ạ
Cháu cảm ơn ạ

Dữ liệu thấy quen quen nhỉ. cái này hình như chú batman1 từng giúp ai đó.

 

[Hoàng Tuấn 868]

Dữ liệu thấy quen quen nhỉ. cái này hình như chú batman1 từng giúp ai đó.

Giúp đi thôi, đừng dền dứ nữa.

 

[BuiQuangThuan]

Giúp đi thôi, đừng dền dứ nữa.

Hihi. Quá sức anh ạ

 

[Hoàng Tuấn 868]

Hihi. Quá sức anh ạ

Cái này không cần code đi chọn file trong các folder mà nên để bật cửa sổ rồi quét chọn file bằng tay cho đơn giản.

Cháu nhờ các Bác và Anh chị giúp cháu bài như file đính kèm ạ
Cháu cảm ơn ạ

Em gửi cho anh Thuận 2 file đích nữa để anh ấy thử thì chắc là vừa tầm, không sợ "quá sức" nữa.

 

[hongphuong1997]

Cái này không cần code đi chọn file trong các folder mà nên để bật cửa sổ rồi quét chọn file bằng tay cho đơn giản.

Em gửi cho anh Thuận 2 file đích nữa để anh ấy thử thì chắc là vừa tầm, không sợ "quá sức" nữa.

file thì em ghi đường dẫn ở cột "B" rùi đó anh

 

[Hoàng Tuấn 868]

file thì em ghi đường dẫn ở cột "B" rùi đó anh

Chọn tay thì không cần đường dẫn, xem file đích để biết cấu trúc của sheet sẽ dán dữ liệu từ sheet nguồn vào mà.

 

[hongphuong1997]

Chọn tay thì không cần đường dẫn, xem file đích để biết cấu trúc của sheet sẽ dán dữ liệu từ sheet nguồn vào mà.

Anh oi, em không thick chọn tay vì khi đó lại phải ngồi để chờ đợi.
Và mặt khác vì trong ổ cứng có rất nhiều thư mục và nhiều file, nên dễ bị chọn nhầm lắm
Anh viết giúp em với ạ.

 

[HUONGHCKT]

Cháu nhờ các Bác và Anh chị giúp cháu bài như file đính kèm ạ
Cháu cảm ơn ạ

Góp vui. code củ chuối, trúng- trật, hên-sui.
nhấn vào mặt cười để chạy code.

 

[BuiQuangThuan]

file thì em ghi đường dẫn ở cột "B" rùi đó anh

Tự test kết quả lấy. Chưa có bẫy lỗi

Option Explicit
Sub ABC()
    Dim Wb As Workbook, WbM As Workbook
    Dim Ws As Worksheet, sArr(), i&
    Set Wb = ThisWorkbook
    Set Ws = Wb.Sheets("ThongKe")
    sArr = Wb.Sheets("vung").Range("B2:B" & Wb.Sheets("vung").Range("B" & Rows.Count).End(3).Row).Value
    For i = 1 To UBound(sArr)
        Application.Workbooks.Open (sArr(i, 1))
        Set WbM = ActiveWorkbook
        Ws.Range("A6:U100").Copy WbM.Sheets("ThongKe").Range("A6")
        WbM.Close True
    Next
End Sub

 

[Hoàng Tuấn 868]

Anh oi, em không thick chọn tay vì khi đó lại phải ngồi để chờ đợi.
Và mặt khác vì trong ổ cứng có rất nhiều thư mục và nhiều file, nên dễ bị chọn nhầm lắm
Anh viết giúp em với ạ.

Mình có viết thì cũng dài và chạy chậm hơn code của 2 bạn trên nên bạn dùng 2 code này đi nhé.

 

[BuiQuangThuan]

Mình có viết thì cũng dài và chạy chậm hơn code của 2 bạn trên nên bạn dùng 2 code này đi nhé.

Anh cứ viết đi. Em muốn tham khảo mờ. Anh đã viết đâu mà biết nhanh hay chậm hơn.

 

[Hoàng Tuấn 868]

Anh cứ viết đi. Em muốn tham khảo mờ. Anh đã viết đâu mà biết nhanh hay chậm hơn.

Mình viết rồi, đang chạy thử mà giờ chưa chạy xong. Khi nào chạy xong mình đưa lên.

 

[hongphuong1997]

Em cảm ơn tất cả các anh @HUONGHCKT @BuiQuangThuan @Hoàng Tuấn 868 code chạy rất chuẩn các anh oi
à anh @BuiQuangThuan oi, em không biết lỗi ở chỗ nào?
Anh Thêm bẫy lỗi giúp em với ạ
Em cảm ơn các anh

 

[BuiQuangThuan]

Anh Thêm bẫy lỗi giúp em với ạ

Bạn tự viết thêm cái bẫy lỗi đi.
Nếu dữ liệu cột B nhỏ hơn 2 thì lỗi
Nếu đường dẫn tại cột B không tồn tại cũng lỗi

 

[hongphuong1997]

Bạn tự viết thêm cái bẫy lỗi đi.
Nếu dữ liệu cột B nhỏ hơn 2 thì lỗi
Nếu đường dẫn tại cột B không tồn tại cũng lỗi

à, như vậy thì không cần bẫy lỗi cũng được anh oi
Em cảm ơn anh ạ

 

[hongphuong1997]

Tự test kết quả lấy. Chưa có bẫy lỗi

Option Explicit
Sub ABC()
    Dim Wb As Workbook, WbM As Workbook
    Dim Ws As Worksheet, sArr(), i&
    Set Wb = ThisWorkbook
    Set Ws = Wb.Sheets("ThongKe")
    sArr = Wb.Sheets("vung").Range("B2:B" & Wb.Sheets("vung").Range("B" & Rows.Count).End(3).Row).Value
    For i = 1 To UBound(sArr)
        Application.Workbooks.Open (sArr(i, 1))
        Set WbM = ActiveWorkbook
        Ws.Range("A6:U100").Copy WbM.Sheets("ThongKe").Range("A6")
        WbM.Close True
    Next
End Sub

@BuiQuangThuan anh oi!
Em xin mở rộng câu hỏi thêm chút síu anh nhé

 

[BuiQuangThuan]

@BuiQuangThuan anh oi!
Em xin mở rộng câu hỏi thêm chút síu anh nhé

Bạn cứ mở tự nhiên. Mình nghĩ là được. Nhưng sợ lại quá sức với mình. Chờ các anh chị khác coi các anh chị giúp sao.
Mình nghĩ quét tất cả các file trong thư mục bạn đã khai báo và mở từng file lên và làm như trước thôi. Bạn có thể tìm hiểu được mà. Cố lên

 

[hongphuong1997]

Bạn cứ mở tự nhiên. Mình nghĩ là được. Nhưng sợ lại quá sức với mình. Chờ các anh chị khác coi các anh chị giúp sao.
Mình nghĩ quét tất cả các file trong thư mục bạn đã khai báo và mở từng file lên và làm như trước thôi. Bạn có thể tìm hiểu được mà. Cố lên

Hihi..... nói thật sự với anh, em tuy hỏi bài cực nhiều và cũng được rất nhiều anh chị và các Bác siêu cao thủ trên GPE dạy dỗ rất nhiệt tình:
Nhưng thực tình em không thể tự viết code được
Em thật sự đáng buồn về bộ não của em.

 

[BuiQuangThuan]

Hihi..... nói thật sự với anh, em tuy hỏi bài cực nhiều và cũng được rất nhiều anh chị và các Bác siêu cao thủ trên GPE dạy dỗ rất nhiệt tình:
Nhưng thực tình em không thể tự viết code được
Em thật sự đáng buồn về bộ não của em.

Thử tìm hiểu thêm về FileSystemObject
Tại mình biếng. Nên gợi ý cho bạn thế. Bạn chờ được. Mình sẽ làm cho bạn lúc rảnh nha?
Chờ thêm chút nữa. Chắc sẽ có người giúp bạn à