Option Explicit
Public Sub Tonghop()
Application.ScreenUpdating = False
Const MaxR As Long = 1000
Dim Dic As Object, Ws As Worksheet, tArr(), dArr(1 To MaxR, 1 To 6)
Dim I As Long, K As Long, R As Long, Rws As Long, Tmp As String, MyName As String, TT As String, TA As String
Set Dic = CreateObject("Scripting.Dictionary")
MyName = "TONG"
TT = "TRANG_CHU"
TA = "Sheet1"
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> MyName And Ws.Name <> TT And Ws.Name <> TA Then
tArr = Ws.Range("B3", Ws.Range("B3").End(xlDown)).Resize(, 5).Value2
R = UBound(tArr)
For I = 1 To R
Tmp = tArr(I, 1) & "#" & tArr(I, 2)
If Not Dic.Exists(Tmp) Then
K = K + 1
Dic.Item(Tmp) = K
dArr(K, 1) = K
dArr(K, 2) = tArr(I, 1)
dArr(K, 3) = tArr(I, 2)
dArr(K, 4) = tArr(I, 3)
dArr(K, 5) = tArr(I, 4)
dArr(K, 6) = tArr(I, 5)
Else
Rws = Dic.Item(Tmp)
dArr(Rws, 4) = dArr(Rws, 4) + tArr(I, 3)
End If
Next I
End If
Next Ws
With Sheets(MyName)
.Range("A3").Resize(MaxR, 6).ClearContents
.Range("A3").Resize(K, 6) = dArr
.Range("A3").Resize(K, 6).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub