Tổng hợp dữ liệu từ các sheet sang sheet tổng (1 người xem)

Sub TongHop()
Dim i&, j&, Lr&, R&, C&, Col&
Dim Sh As Worksheet, Ws As Worksheet
Dim Dic As Object, Key
Dim Arr(), KQ()

Set Dic = CreateObject("Scripting.Dictionary")
Set Ws = Sheets("sum")
Set Rng = Ws.Range(Ws.Cells(7, 1), Ws.Cells(7, Ws.Cells(7, Columns.Count).End(xlToLeft).Column))
C = Rng.Columns.Count
ReDim KQ(1 To 10000, 1 To C)
For Each Sh In Worksheets
    If Sh.Name <> "sum"  Then
        Lr = Sh.Range("A100000").End(xlUp).Row
        Arr = Sh.Range("A7:F" & Lr).Value
        Col = Rng.Find(Sh.[F4]).Column
        For i = 1 To UBound(Arr)
            If Arr(i, 1) <> Emty Then
                Key = Arr(i, 1)
            If Not Dic.Exists(Key) Then
                j = j + 1: Dic.Add (Key), j
                KQ(j, 1) = Key
                KQ(j, Col) = Arr(i, 6)
            Else
                k = Dic.Item(Key)
                KQ(k, Col) = Arr(i, 6)
            End If
            End If
        Next i
    End If
Next Sh

If j Then Ws.Range("A8").Resize(j, C) = KQ
Set Dic = Nothing
End Sub