Cập nhật dữ liệu từ sheet phụ sang sheet tổng (2 người xem)

[Gà Công Nghệ]

Nhờ Anh chị hỗ trợ giùm em cập nhật từ sheet phụ sang sheet tổng (Sheet phụ của 1 ngày nào đó mà có thêm hay chỉnh sửa gì thì sheet tổng sẽ cập nhật theo). Em xin cám ơn nhiều!

 

[chiendich]

Nhờ Anh chị hỗ trợ giùm em cập nhật từ sheet phụ sang sheet tổng (Sheet phụ của 1 ngày nào đó mà có thêm hay chỉnh sửa gì thì sheet tổng sẽ cập nhật theo). Em xin cám ơn nhi

Bạn kiểm tra xem!

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("B2").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