Sub TongHopSh()
Dim Dic, sh As Worksheet, iRow As Long, i As Long, j As Long
Dim Arr(), TmpArr, TG As Double
On Error Resume Next
TG = Timer
Application.ScreenUpdating = False
Sheets("TongHop").Range("C6:G60000").ClearContents
With CreateObject("Scripting.Dictionary")
For Each sh In Worksheets
If sh.Name <> "TongHop" And sh.Name <> "DM" Then
TmpArr = sh.Range(sh.[c6], sh.[C65536].End(xlUp)).Resize(, 5).Value
For iRow = 1 To UBound(TmpArr, 1)
If Not IsEmpty(TmpArr(iRow, 1)) Then
If Not .Exists(TmpArr(iRow, 1)) Then
i = i + 1
.Add TmpArr(iRow, 1), i
ReDim Preserve Arr(1 To 5, 1 To i)
For j = 1 To 5
Arr(j, i) = TmpArr(iRow, j)
Next
Else
Arr(3, .Item(TmpArr(iRow, 1))) = Arr(3, .Item(TmpArr(iRow, 1))) + TmpArr(iRow, 3)
Arr(5, .Item(TmpArr(iRow, 1))) = Arr(5, .Item(TmpArr(iRow, 1))) + TmpArr(iRow, 5)
End If
End If
Next
End If
Next
End With
Sheets("TongHop").Range("C6").Resize(i, 5) = WorksheetFunction.Transpose(Arr)
Application.ScreenUpdating = True
MsgBox Timer - TG
End Sub