Tổng hợp cộng dữ liệu từ nhiều file vào 1 file (1 người xem)

[phuocrobe]

Một file dữ liệu của mình gồm có 2 sheet và mình muốn tạo 1 file TongHop.xls để cộng tất cả dữ liệu từ 2 sheet của từng file vào 2 sheet tương tự ở file TongHop.xls
Do số lượng file để tổng hợp không cố định nên ở file TongHop.xls mình có tạo 1 sheet HUONDAN để nhập tên file vào đó từ vùng B5:B34 (trong bài viết có giới hạn nên mình chỉ post 3 file).
Làm sao để khi nhấn nút TổngHợp ở sheet M01 của file TổngHợp thì sẽ cộng dữ liệu của các file có tên ở sheet HUONGDAN vào file TongHop.xls
Cụ thể:
'[Tong Hop.xls]M01'!$C$11 = '[file1.xls]M01'!$C$11 + '[file2.xls]M01'!$C$11 , tương tự cho các ô từ C11:N26 ở sheet M01
'[Tong Hop.xls]M01.1'!$C$14 = '[file1.xls]M01.1'!$C$14 + '[file2.xls]M01.1'!$C$14 , tương tự cho các ô từ C11:O26 ở sheet M02
(cộng các ô có tô màu nền, và những ô có tô màu nền này đều ở vị trí cố định tại các file tương tự nhau)
Nhờ các anh chị giúp mình với nhé.
Em xin cám ơn rất nhiều ạ.

 

[Ba Tê]

Cám ơn bạn đã góp ý, mình cứ tưởng file trước có dữ liệu rồi nên quên up file à. Nhờ bạn giúp mình vụ này nữa nha, cám ơn bạn nhiều à.

Các sheet M06 lấy vùng A15:S44 hay A15:S45 hay A16:S45 ???
Mở từng file rồi nhìn từng vùng "chóng mặt" thiệt.
Mỗi file có 39 Name rác, báo lỗi tùm lum.
Bạn xem lại, các file phải ở cùng Folder nhé. Tôi chỉ gởi lại file Tonghop thôi.

 

[phuocrobe]

Cám ơn anh nhiều nha. Em đã tự sửa file gốc được rồi à, khai báo thêm vài biến nữa để dùng cho các sheet khác thì nó mới chạy được, hi

Các sheet M06 lấy vùng A15:S44 hay A15:S45 hay A16:S45 ???
Mở từng file rồi nhìn từng vùng "chóng mặt" thiệt.
Mỗi file có 39 Name rác, báo lỗi tùm lum.
Bạn xem lại, các file phải ở cùng Folder nhé. Tôi chỉ gởi lại file Tonghop thôi.

 

[phuocrobe]

Do file dữ liệu của mình lên đến 1000 dòng nhưng trong đó chỉ khoảng 3/10 là các dòng có dữ liệu còn lại đa số là hàng trống nên vì vậy mình muốn đặt điều kiện trước khi lọc qua file TongHop.xls sẽ kiểm tra điều kiện nếu tại (C15:C45 sheet M06 của các file1.xls, file2.xls, file3.xls) >0 ... thì sẽ lấy dữ liệu tại các dòng đó. Còn nếu không sẽ không lấy dữ liệu.
Nhờ anh giúp em điều kiện này với ạ, Em cám ơn anh nhiều !

Các sheet M06 lấy vùng A15:S44 hay A15:S45 hay A16:S45 ???
Mở từng file rồi nhìn từng vùng "chóng mặt" thiệt.
Mỗi file có 39 Name rác, báo lỗi tùm lum.
Bạn xem lại, các file phải ở cùng Folder nhé. Tôi chỉ gởi lại file Tonghop thôi.

 

[phuocrobe]

Mình gặp 1 vấn đề như thế này nên phải nhờ bạn lần nữa vậy.
Trong trường hợp file không có dữ liệu thì khi chạy code nó báo lỗi đoạn này Arr3(K, J) = sArr(I, J)
Bạn giúp mình sửa lỗi này được không vì trên thực tế có nhiều lúc file báo cáo không có dữ liệu là bình thường à. Cám ơn bạn rất nhiều

Các sheet M06 lấy vùng A15:S44 hay A15:S45 hay A16:S45 ???
Mở từng file rồi nhìn từng vùng "chóng mặt" thiệt.
Mỗi file có 39 Name rác, báo lỗi tùm lum.
Bạn xem lại, các file phải ở cùng Folder nhé. Tôi chỉ gởi lại file Tonghop thôi.

 

[Ba Tê]

Mình gặp 1 vấn đề như thế này nên phải nhờ bạn lần nữa vậy.
Trong trường hợp file không có dữ liệu thì khi chạy code nó báo lỗi đoạn này Arr3(K, J) = sArr(I, J)
Bạn giúp mình sửa lỗi này được không vì trên thực tế có nhiều lúc file báo cáo không có dữ liệu là bình thường à. Cám ơn bạn rất nhiều

Bạn xem lại file này, sao không nói trước tất cả các tình huống để xử lý 1 lần?

 

[phuocrobe]

Vì khi làm rồi mới gặp trường hợp như vậy mới biết bạn à.
Sao mình cũng làm tương tự code của bạn nhưng sang file khác thì kết quả hiển thị bị thiếu dòng đầu tiên B12:M12 nhỉ ?
Mình có gửi file đính kèm bạn xem giúp mình với. Cám ơn bạn nhiều nha !

Option ExplicitPublic Sub GPE()
Application.ScreenUpdating = False
Dim sArr(), Arr1(1 To 12000, 1 To 12), tArr()
Dim MyName As String, Pat As String, I As Long, J As Long, K As Long, N As Long
With ActiveWorkbook
MyName = .Name
Pat = .Path & ""
tArr = .Sheets("HUONGDAN").Range("B4", .Sheets("HUONGDAN").Range("B65536").End(xlUp)).Value
End With
For N = 2 To UBound(tArr)
Workbooks.Open Filename:=Pat & tArr(N, 1)
With ActiveWorkbook

sArr = ActiveWorkbook.Sheets("Chua DK").Range("B12:M2000").Value
If sArr(2, 2) <> Empty Then
For I = 1 To UBound(sArr)
If sArr(I, 2) <> Empty Then
K = K + 1
For J = 1 To 12
Arr1(K, J) = sArr(I, J)
Next J
End If
Next I
End If

End With
ActiveWindow.Close False
Next N
Workbooks(MyName).Activate

With Sheets("Chua DK")
.Range("B12").Resize(2000, 12).ClearContents
.Range("B12").Resize(2000, 12).Font.Bold = False
If K Then
.Range("B12:M12").Resize(K) = Arr1
For I = 1 To K
If Arr1(I, 1) Like "DATA*" Then .Range("B" & I + 11).Resize(, 12).Font.Bold = True
Next I
End If
End With
End Sub

Bạn xem lại file này, sao không nói trước tất cả các tình huống để xử lý 1 lần?

 

[Ba Tê]

Vì khi làm rồi mới gặp trường hợp như vậy mới biết bạn à.
Sao mình cũng làm tương tự code của bạn nhưng sang file khác thì kết quả hiển thị bị thiếu dòng đầu tiên B12:M12 nhỉ ?
Mình có gửi file đính kèm bạn xem giúp mình với. Cám ơn bạn nhiều nha !

Nhìn vào cấu trúc dữ liệu thực mới viết code đúng điều kiện được.
Dữ liệu các file1, file2... của bạn đâu có giống các file trước.
Bạn xem C12 có cái gì khác với C15 các sheet M06 lúc trước không rồi bạn tự chỉnh code.

 

[phuocrobe]

Mình mày mò mãi mới được kết quả như mong đợi, lấy luôn cả cột số thứ tự đầu tiên nữa. hihi

Giờ mình mới hiểu đoạn này dùng để tô đậm màu If Arr1(I, 1)Like "DATA*" Then .Range("B" & I + 11).Resize(, 12).Font.Bold = True hay quá.
Bạn có thể cho mình xin code để tô màu nền luôn được không?

Excel nhiều thứ hay ho thật, càng khám phá càng thấy hay

Option ExplicitPublic Sub GPE()
Application.ScreenUpdating = False
Dim sArr(), Arr1(1 To 12000, 1 To 13), tArr()
Dim MyName As String, Pat As String, I As Long, J As Long, K As Long, N As Long
With ActiveWorkbook
MyName = .Name
Pat = .Path & ""
tArr = .Sheets("HUONGDAN").Range("B4", .Sheets("HUONGDAN").Range("B65536").End(xlUp)).Value
End With
For N = 2 To UBound(tArr)
Workbooks.Open Filename:=Pat & tArr(N, 1)
With ActiveWorkbook

sArr = ActiveWorkbook.Sheets("Chua DK").Range("A12:M2000").Value
If sArr(1, 1) <> Empty Then
For I = 1 To UBound(sArr)
If sArr(I, 1) <> Empty Then
K = K + 1
For J = 1 To 13
Arr1(K, J) = sArr(I, J)
Next J
End If
Next I
End If

End With
ActiveWindow.Close False
Next N
Workbooks(MyName).Activate

With Sheets("Chua DK")
.Range("A12").Resize(2000, 13).ClearContents
.Range("A12").Resize(2000, 13).Font.Bold = False
If K Then
.Range("A12:M12").Resize(K) = Arr1
For I = 1 To K
If Arr1(I, 1) Like "DATA*" Then .Range("A" & I + 11).Resize(, 13).Font.Bold = True
Next I
End If
End With
End Sub

Nhìn vào cấu trúc dữ liệu thực mới viết code đúng điều kiện được.
Dữ liệu các file1, file2... của bạn đâu có giống các file trước.
Bạn xem C12 có cái gì khác với C15 các sheet M06 lúc trước không rồi bạn tự chỉnh code.

 

[phuocrobe]

Sau khi mình ghi lại macro để lấy dòng lệnh tô màu nền nhưng khi mình kết hợp 2 câu lệnh tô đậm chữ và tô màu nền cho vùng dữ liệu nhưng sao không được vậy nhỉ?

Workbooks(MyName).Activate With Sheets("Chua DK")
.Range("A12").Resize(5000, 13).ClearContents
.Range("A12").Resize(5000, 13).Font.Bold = False
If K Then
.Range("A12:M12").Resize(K) = Arr1
For I = 1 To K

If Arr1(I, 2) <> Empty Then .Range("A" & I + 11).Resize(, 13).Select
With Selection.Interior
.Font.Bold = True
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0

End With
Next I
End If
End With

Nhìn vào cấu trúc dữ liệu thực mới viết code đúng điều kiện được.
Dữ liệu các file1, file2... của bạn đâu có giống các file trước.
Bạn xem C12 có cái gì khác với C15 các sheet M06 lúc trước không rồi bạn tự chỉnh code.

 

[phuocrobe]

Khi mình copy dòng này K = K + 1: Arr2(K, 1) = K để sử dụng tương tự cho các sheet khác thì nó báo lỗi tại dòng này và nhảy dòng tùm lum hết mà không theo thứ tự nào cả. Hix

Mình có gửi file đính kèm bạn xem giúp mình với nhé.

Sub tonghop()
Call sapxep
End Sub
Public Sub sapxep()
Application.ScreenUpdating = False
Dim sArr(), Arr2(1 To 30, 1 To 10), Arr3(1 To 30, 1 To 10), Arr4(1 To 30, 1 To 11), Arr5(1 To 30, 1 To 11), Arr6(1 To 30, 1 To 12), Arr7(1 To 30, 1 To 12), Arr8(1 To 30, 1 To 13), Arr9(1 To 30, 1 To 13), Arr10(1 To 30, 1 To 13), Arr11(1 To 30, 1 To 13), Arr12(1 To 30, 1 To 13), Arr13(1 To 30, 1 To 13), Arr14(1 To 30, 1 To 13), Arr15(1 To 30, 1 To 8), Arr16(1 To 30, 1 To 8), tArr()
Dim MyName As String, Pat As String, I As Long, J As Long, K As Long, N As Long, L As Long, M As Long
With ActiveWorkbook
MyName = .Name
Pat = .Path & ""
tArr = Sheets("HUONGDAN").Range("B6:B35").Value
End With
For N = 1 To 30

If tArr(N, 1) <> "" Then


Workbooks.Open Filename:=Pat & tArr(N, 1)
If Err.Number <> 0 Then GoTo tiep

sArr = ActiveWorkbook.Sheets("PL1").Range("A14:J14").Value
For I = 1 To UBound(sArr)
If sArr(I, 3) <> "" Then
K = K + 1: Arr2(K, 1) = K
For J = 2 To 10
Arr2(K, J) = sArr(I, J)
Next J
End If
Next I

sArr = ActiveWorkbook.Sheets("PL2").Range("A14:J14").Value
For I = 1 To UBound(sArr)
If sArr(I, 3) <> "" Then
K = K + 1: Arr3(K, 1) = K
For J = 2 To 10
Arr3(K, J) = sArr(I, J)
Next J
End If
Next I

sArr = ActiveWorkbook.Sheets("PL3").Range("A14:K14").Value
For I = 1 To UBound(sArr)
If sArr(I, 3) <> "" Then
K = K + 1: Arr4(K, 1) = K
For J = 2 To 11
Arr4(K, J) = sArr(I, J)
Next J
End If
Next I

ActiveWorkbook.Close False
End If
tiep:
Err.Clear
Next N

Workbooks(MyName).Activate



Sheets("PL1").Range("A14").Resize(30, 10).ClearContents
Sheets("PL1").Range("A14:J14").Resize(K) = Arr2

Sheets("PL2").Range("A14").Resize(30, 10).ClearContents
Sheets("PL2").Range("A14:J14").Resize(K) = Arr3

Sheets("PL3").Range("A14").Resize(30, 10).ClearContents
Sheets("PL3").Range("A14:K14").Resize(K) = Arr4



Application.ScreenUpdating = False


End Sub

Đây là file đã chỉnh code, lấy dữ liệu sheet M06 của các file.

 

[phuocrobe]

Sau 1 thời gian mày mò , cuối cùng cũng đã tìm ra vấn đề, đúng là muốn học excel thì cần phải kiên trì và tỉ mỉ... sai 1 ly đi 1 dặm thật cám ơn cả nhà nhé .

Khi mình copy dòng này K = K + 1: Arr2(K, 1) = K để sử dụng tương tự cho các sheet khác thì nó báo lỗi tại dòng này và nhảy dòng tùm lum hết mà không theo thứ tự nào cả. Hix

Mình có gửi file đính kèm bạn xem giúp mình với nhé.

 

[mabuucam]

mình cũng đang muốn gộp 3 files vào thành 1 files. mong được giúp đỡ. mình cám ơn nhiều ạ.

 

[mabuucam]

View attachment Thang 01.xlsx

mình cũng đang muốn gộp 3 files vào thành 1 files. mong được giúp đỡ. mình cám ơn nhiều ạ.

Mình đính kèm file. Mong được sự hướng dẫn của các bạn. Mình cảm ơn.