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

[dohungmo]

Hiện tại em có 1 file có cùng cấu trúc bố trí theo 1 form nhất định . Hiện em đang dùng hàm VLOOKUP để tổng hợp bằng cách thay đổi số tên theo thứ tự các sheet . Rất mong các anh / chị hỗ trợ em bằng code VBA . Em cảm ơn .

 

[Lê Duy Thương]

nếu dữ liệu như file thì vầy =VLOOKUP($A8,INDIRECT(COLUMN()-3&"!$A:$F"),6,0)

 

[HUONGHCKT]

Hiện tại em có 1 file có cùng cấu trúc bố trí theo 1 form nhất định . Hiện em đang dùng hàm VLOOKUP để tổng hợp bằng cách thay đổi số tên theo thứ tự các sheet . Rất mong các anh / chị hỗ trợ em bằng code VBA . Em cảm ơn .

Tham khảo code sau:

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" And Sh.Name <> "sum (2)" 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 R Then Ws.Range("A8").Resize(R, C) = KQ
Set Dic = Nothing
End Sub