Copy nhiều files (có nhiều sheets) vào 1 file (có nhiều sheets)

suikt

Thành viên mới
Tham gia ngày
11 Tháng tư 2014
Bài viết
10
Được thích
0
Điểm
363
Các sếp ơi,

Em đang cố gắng mày mò VBA cho công việc hàng ngày nhưng em sửa code mà không chạy được. Nhờ các sếp giúp em với.
- Em có khoản 110 files như trong zip sources;
- Em muốn copy value thôi ah từ sheet "summary" của các110 files trong sources vào sheet tổng của file consolidation;
- Nếu cho em chọn files từ sources nào càng tốt - code này để luôn link chết mà em ko biết thay thế nào;
- Cuối cùng, khi một file source mở ra, copy xong thì nó lại hiện ra cái bảng alert - có cách nào giúp em để nó ko hiện ra luôn ko ah - cứ cập nhật hết rồi báo xong thôi í.

Các sếp cứu em với. Vì này nhiều files quá em làm tốn thời gian và bị sót nữa.

Em thành thật cảm ơn các sếp.
HC
 

File đính kèm

vanthinh3101

Thành viên tích cực
Tham gia ngày
24 Tháng một 2015
Bài viết
865
Được thích
962
Điểm
560
Tuổi
32
Nơi ở
Hà Nội
Các sếp ơi,

Em đang cố gắng mày mò VBA cho công việc hàng ngày nhưng em sửa code mà không chạy được. Nhờ các sếp giúp em với.
- Em có khoản 110 files như trong zip sources;
- Em muốn copy value thôi ah từ sheet "summary" của các110 files trong sources vào sheet tổng của file consolidation;
- Nếu cho em chọn files từ sources nào càng tốt - code này để luôn link chết mà em ko biết thay thế nào;
- Cuối cùng, khi một file source mở ra, copy xong thì nó lại hiện ra cái bảng alert - có cách nào giúp em để nó ko hiện ra luôn ko ah - cứ cập nhật hết rồi báo xong thôi í.

Các sếp cứu em với. Vì này nhiều files quá em làm tốn thời gian và bị sót nữa.

Em thành thật cảm ơn các sếp.
HC
Chúc bạn thành công.
PHP:
Sub ConsolidateData()
    Dim Item, Arr(), lR As Long
    Dim Wb As Workbook, Ws As Worksheet, MainWb As Worksheet
   
    Application.ScreenUpdating = False      'Loai bo nhay man hinh
    Application.DisplayAlerts = False       'Loai bo canh bao
    Application.AskToUpdateLinks = False    'Loai bo man hinh hoi update
    Set MainWb = ThisWorkbook.Sheets("Consolidation")
    MainWb.Range("A6:APG65000").ClearContents
   
    With Application.FileDialog(msoFileDialogFilePicker)    'Mo cua so File/Open de chon file can tong hop
        .AllowMultiSelect = True        'Cho phep chon nhieu file cung 1 luc
        .Filters.Add "Microsoft Excel Files", "*.xls*", 1   'Quy dinh loai file duoc chon
       
        'Canh bao va thoat thu tuc khi khong chon file
        If Not .Show = -1 Then MsgBox "No files selected", vbCritical, "GPE": Exit Sub
       
        'Lap qua tung file trong so cac file duoc chon
        For Each Item In .SelectedItems
            'Mo file duoc chon
            Set Wb = Workbooks.Open(Item)
            'Dua cac thong tin can lay vao mang Arr
            Arr() = Wb.Sheets("Summary").Range("A7:APG7").Value
            With MainWb
                'Xac dinh dong de ghi du lieu da lay (=dong cuoi co du lieu+1)
                lR = .Range("D" & Rows.Count).End(xlUp).Row + 1
                'Ghi du lieu da lay vao vi tri dung
                .Range("A" & lR).Resize(, 1099) = Arr
            End With
            'Dong file da chon, khong luu thay doi
            Wb.Close False
        Next Item
    End With
    'Thiet lap lai theo cac che do mac dinh cua Excel
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
   
    Set MainWb = Nothing
    'Thong bao da hoan thanh thu tuc
    MsgBox "Done", vbInformation, "GPE"
End Sub
 
Lần chỉnh sửa cuối:

vanaccex

Thành viên thường trực
Tham gia ngày
8 Tháng bảy 2018
Bài viết
350
Được thích
199
Điểm
195
Chúc bạn thành công.
PHP:
Sub ConsolidateData()
    Dim Item, Arr(), lR As Long
    Dim Wb As Workbook, Ws As Worksheet, MainWb As Worksheet
  
    Application.ScreenUpdating = False      'Loai bo nhay man hinh
    Application.DisplayAlerts = False       'Loai bo canh bao
    Application.AskToUpdateLinks = False    'Loai bo man hinh hoi update
    Set MainWb = ThisWorkbook.Sheets("Consolidation")
    MainWb.Range("A6:APG65000").ClearContents
  
    With Application.FileDialog(msoFileDialogFilePicker)    'Mo cua so File/Open de chon file can tong hop
        .AllowMultiSelect = True        'Cho phep chon nhieu file cung 1 luc
        .Filters.Add "Microsoft Excel Files", "*.xls*", 1   'Quy dinh loai file duoc chon
      
        'Canh bao va thoat thu tuc khi khong chon file
        If Not .Show = -1 Then MsgBox "No files selected", vbCritical, "GPE": Exit Sub
      
        'Lap qua tung file trong so cac file duoc chon
        For Each Item In .SelectedItems
            'Mo file duoc chon
            Set Wb = Workbooks.Open(Item)
            'Dua cac thong tin can lay vao mang Arr
            Arr() = Wb.Sheets("Summary").Range("A7:APG7").Value
            With MainWb
                'Xac dinh dong de ghi du lieu da lay (=dong cuoi co du lieu+1)
                lR = .Range("D" & Rows.Count).End(xlUp).Row + 1
                'Ghi du lieu da lay vao vi tri dung
                .Range("A" & lR).Resize(, 1099) = Arr
            End With
            'Dong file da chon, khong luu thay doi
            Wb.Close False
        Next Item
    End With
    'Thiet lap lai theo cac che do mac dinh cua Excel
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
  
    Set MainWb = Nothing
    'Thong bao da hoan thanh thu tuc
    MsgBox "Done", vbInformation, "GPE"
End Sub
Cho em hỏi anh chút là giả sử khi copy file nhiều file. Mở file có có nhiều sheet giống nhau về tên thì khi copy vào 1 file có xảy ra hiện tượng trùng tên ko ạ
 

vanthinh3101

Thành viên tích cực
Tham gia ngày
24 Tháng một 2015
Bài viết
865
Được thích
962
Điểm
560
Tuổi
32
Nơi ở
Hà Nội
Cho em hỏi anh chút là giả sử khi copy file nhiều file. Mở file có có nhiều sheet giống nhau về tên thì khi copy vào 1 file có xảy ra hiện tượng trùng tên ko ạ
Trong cùng 1 file excel, không thể có các Sheet trùng tên nhau bạn nhé!
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,520
Được thích
2,375
Điểm
360
Cho em hỏi anh chút là giả sử khi copy file nhiều file. Mở file có có nhiều sheet giống nhau về tên thì khi copy vào 1 file có xảy ra hiện tượng trùng tên ko ạ
không sao em nhé vì khi mình chon 1 file rồi thì không có sheets trùng tên,nên bạn không phải lo các file có sheets giống nhau.nó vẫn phân biệt được.:D
 

vanaccex

Thành viên thường trực
Tham gia ngày
8 Tháng bảy 2018
Bài viết
350
Được thích
199
Điểm
195
Dạ ý em là file 1 có sheet TenLaA, TenLaB......, file 2 cũng có tên sheet giống với tên sheet ở sheet 1 Chứ ko phải là 1 file có nhiều sheet có tên giống nhau ạ
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,520
Được thích
2,375
Điểm
360
Dạ ý em là file 1 có sheet TenLaA, TenLaB......, file 2 cũng có tên sheet giống với tên sheet ở sheet 1 Chứ ko phải là 1 file có nhiều sheet có tên giống nhau ạ
đúng rồi vì em không thể duyệt 2 file cùng 1 lúc mà em.em phải chuyển file chứ.em ko thấy code ở trên là duyệt qua từng file à.nên không cần lo lắng vấn đề đấy.
 

suikt

Thành viên mới
Tham gia ngày
11 Tháng tư 2014
Bài viết
10
Được thích
0
Điểm
363
Chúc bạn thành công.
PHP:
Sub ConsolidateData()
    Dim Item, Arr(), lR As Long
    Dim Wb As Workbook, Ws As Worksheet, MainWb As Worksheet
  
    Application.ScreenUpdating = False      'Loai bo nhay man hinh
    Application.DisplayAlerts = False       'Loai bo canh bao
    Application.AskToUpdateLinks = False    'Loai bo man hinh hoi update
    Set MainWb = ThisWorkbook.Sheets("Consolidation")
    MainWb.Range("A6:APG65000").ClearContents
  
    With Application.FileDialog(msoFileDialogFilePicker)    'Mo cua so File/Open de chon file can tong hop
        .AllowMultiSelect = True        'Cho phep chon nhieu file cung 1 luc
        .Filters.Add "Microsoft Excel Files", "*.xls*", 1   'Quy dinh loai file duoc chon
      
        'Canh bao va thoat thu tuc khi khong chon file
        If Not .Show = -1 Then MsgBox "No files selected", vbCritical, "GPE": Exit Sub
      
        'Lap qua tung file trong so cac file duoc chon
        For Each Item In .SelectedItems
            'Mo file duoc chon
            Set Wb = Workbooks.Open(Item)
            'Dua cac thong tin can lay vao mang Arr
            Arr() = Wb.Sheets("Summary").Range("A7:APG7").Value
            With MainWb
                'Xac dinh dong de ghi du lieu da lay (=dong cuoi co du lieu+1)
                lR = .Range("D" & Rows.Count).End(xlUp).Row + 1
                'Ghi du lieu da lay vao vi tri dung
                .Range("A" & lR).Resize(, 1099) = Arr
            End With
            'Dong file da chon, khong luu thay doi
            Wb.Close False
        Next Item
    End With
    'Thiet lap lai theo cac che do mac dinh cua Excel
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
  
    Set MainWb = Nothing
    'Thong bao da hoan thanh thu tuc
    MsgBox "Done", vbInformation, "GPE"
End Sub
Nhanh va loi hai qua Sep. Em cam on rat rat nhieu.
 

suikt

Thành viên mới
Tham gia ngày
11 Tháng tư 2014
Bài viết
10
Được thích
0
Điểm
363
Bạn Văn Thịnh ơi, mình không hiểu sao - dùng cho các file khác thì lại ko đúng như thế này.

Không biết lý do luôn. Giúp mình với! Cảm ơn rất nhiều. File 1, 2, 3, 4 là file nguồn. File Consolidation là file tổng hợp và tổng hợp vào sheet "Detail" í.
 

File đính kèm

suikt

Thành viên mới
Tham gia ngày
11 Tháng tư 2014
Bài viết
10
Được thích
0
Điểm
363
Cảm ơn bạn, nhưng code này cũng đang chỉ lấy dòng dữ liệu đầu tiên của các file dữ liệu mà không lấy hết dữ liệu.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,520
Được thích
2,375
Điểm
360
Cảm ơn bạn, nhưng code này cũng đang chỉ lấy dòng dữ liệu đầu tiên của các file dữ liệu mà không lấy hết dữ liệu.
Code này không lấy hết dòng dữ liệu mà :D.
Bạn xem thêm thế này có đúng không nhé.
Mã:
Sub ConsolidateData()
    Dim Item, Arr(), lR As Long,a as long   
    Dim Wb As Workbook, Ws As Worksheet, MainWb As Worksheet
 
    Application.ScreenUpdating = False      'Loai bo nhay man hinh
    Application.DisplayAlerts = False       'Loai bo canh bao
    Application.AskToUpdateLinks = False    'Loai bo man hinh hoi update
    Set MainWb = ThisWorkbook.Sheets("Consolidation")
    MainWb.Range("A6:APG65000").ClearContents
 
    With Application.FileDialog(msoFileDialogFilePicker)    'Mo cua so File/Open de chon file can tong hop
        .AllowMultiSelect = True        'Cho phep chon nhieu file cung 1 luc
        .Filters.Add "Microsoft Excel Files", "*.xls*", 1   'Quy dinh loai file duoc chon
      
        'Canh bao va thoat thu tuc khi khong chon file
        If Not .Show = -1 Then MsgBox "No files selected", vbCritical, "GPE": Exit Sub
      
        'Lap qua tung file trong so cac file duoc chon
        For Each Item In .SelectedItems
            'Mo file duoc chon
            Set Wb = Workbooks.Open(Item)
            'Dua cac thong tin can lay vao mang Arr
            a=Wb.Sheets("Summary").Range("A"&rows.count).end(xlup).row
            Arr() = Wb.Sheets("Summary").Range("A7:APG" & a).Value
            With MainWb
                'Xac dinh dong de ghi du lieu da lay (=dong cuoi co du lieu+1)
                lR = .Range("D" & Rows.Count).End(xlUp).Row + 1
                'Ghi du lieu da lay vao vi tri dung
                .Range("A" & lR).Resize(a, 1099) = Arr
            End With
            'Dong file da chon, khong luu thay doi
            Wb.Close False
        Next Item
    End With
    'Thiet lap lai theo cac che do mac dinh cua Excel
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
 
    Set MainWb = Nothing
    'Thong bao da hoan thanh thu tuc
    MsgBox "Done", vbInformation, "GPE"
End Sub
 

vanthinh3101

Thành viên tích cực
Tham gia ngày
24 Tháng một 2015
Bài viết
865
Được thích
962
Điểm
560
Tuổi
32
Nơi ở
Hà Nội
Bạn Văn Thịnh ơi, mình không hiểu sao - dùng cho các file khác thì lại ko đúng như thế này.

Không biết lý do luôn. Giúp mình với! Cảm ơn rất nhiều. File 1, 2, 3, 4 là file nguồn. File Consolidation là file tổng hợp và tổng hợp vào sheet "Detail" í.
Code ở bài #2 tôi viết mục đích chỉ lấy đúng 1 dòng dữ liệu ở file chi tiết.
Tôi thấy bạn không nói có vấn đề gì nghĩa là đã đúng ý.
Trường hợp mới của bạn thì có khác biệt:
- File chi tiết có thể không có/có 1/hoặc nhiều dòng dữ liệu cần tổng hợp
- File chi tiết không cố định dòng bắt đầu có dữ liệu sau 2 dòng tiêu đề là dòng nào.
Để giải quyết 2 vấn đề ở trên cần có cách xác định dòng đầu tiên có dữ liệu sau dòng 4 (theo template mà bạn đưa) và có 2 trường hợp xảy ra
- Kết quả >4 --> file chi tiết có dữ liệu cần tổng hợp
- Kết quả =3 --> file chi tiết không có dữ liệu cần tổng hợp
Code cho công việc trên
PHP:
eR= Sheet1.Range("A:A").Find("*", Sheet1.Range("A4")).Row
Đối với trường hợp có nhiều dòng dữ liệu cần tổng hợp thì khi tổng hợp kết quả của từng file chi tiết, cần phải xác định kích thước của mảng Arr()
Tôi sửa lại code cho bạn (lấy cả dòng tiêu đề) như sau:
PHP:
Sub ConsolidateData()
    Dim Item, Arr(), lR As Long, eR As Long, lR1 As Long, x As Integer
    Dim Wb As Workbook, Ws As Worksheet, MainWb As Worksheet
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Set MainWb = ThisWorkbook.Sheets("Detail")
    MainWb.Range("A3:I65000").ClearContents
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls*", 1
        
        If Not .Show = -1 Then MsgBox "No files selected", vbCritical, "GPE": Exit Sub
        
        For Each Item In .SelectedItems
            x = x + 1
            Set Wb = Workbooks.Open(Item)
            With Wb.Sheets("ABC")
                If x = 1 Then
                    .Range("A3:I4").Copy MainWb.Range("A3:I4")
                End If
                
                eR = .Range("A:A").Find("*", .Range("A4")).Row
                If eR > 4 Then
                    lR = .Range("A" & Rows.Count).End(xlUp).Row
                    Arr() = .Range("A" & eR).Resize(lR, 9).Value
                
                    lR1 = MainWb.Range("D" & Rows.Count).End(xlUp).Row + 1
                    MainWb.Range("A" & lR1).Resize(UBound(Arr, 1), 9) = Arr
                End If
            End With
            Wb.Close False
        Next Item
        MainWb.Range("A3").CurrentRegion.EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    
    Set MainWb = Nothing
    MsgBox "Done", vbInformation, "GPE"
End Sub
 
Top Bottom