Option Explicit
Sub doichieu()
Dim lr&, i&, k&, m&, rng, res(1 To 10000, 1 To 12), st$, n
Dim ws As Worksheet, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
n = Left(ws.Name, 1)
If IsNumeric(n) Then
lr = ws.Cells(Rows.Count, "C").End(xlUp).Row
rng = ws.Range("B5:H" & lr).Value
For i = 1 To UBound(rng)
st = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3) & "|" & rng(i, 4)
If Not dic.exists(st) Then
dic.Add st, ""
k = k + 1: res(k, 1) = st
res(k, n * 2) = rng(i, 6)
res(k, n * 2 + 1) = rng(i, 7)
Else
For m = 1 To k
If res(m, 1) = st Then
res(m, n * 2) = res(m, n * 2) + rng(i, 6)
res(m, n * 2 + 1) = res(m, n * 2 + 1) + rng(i, 7)
End If
Next
End If
Next
End If
Next
dic.RemoveAll
Sheets("Doichieu").Activate
Range("B5:L10000").ClearContents
Range("B5").Resize(k, 12).Value = res
End Sub