Public Sub TongHop()
Dim Ws As Worksheet, Rng As Range, Tam, r As Long, c As Long, i, k
Dim TH, Tg
Tg = Timer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
TH = "TH_"
With CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Left(Ws.Name, 3) = TH Then
Ws.Delete
Else
.Item(Trim(Split(Ws.Name, "(")(0))) = .Item(Trim(Split(Ws.Name, "(")(0))) + 1
End If
Next Ws
Tam = .keys
For i = 0 To .Count - 1
k = 0
For Each Ws In Worksheets
If Trim(Split(Ws.Name, "(")(0)) = Tam(i) Then
Ws.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = TH & Tam(i)
Sheets(Sheets.Count).Tab.ColorIndex = 5
Exit For
End If
Next Ws
For Each Ws In Worksheets
If Trim(Split(Ws.Name, "(")(0)) = Tam(i) Then
k = k + 1
For Each Rng In Ws.UsedRange.SpecialCells(xlCellTypeConstants)
r = Rng.Row: c = Rng.Column
If c <> 1 Then
If IsNumeric(Rng.Value) And Trim(Rng.Value) <> "" Then
If k = 1 Then Sheets(TH & Tam(i)).Cells(r, c) = ""
Sheets(TH & Tam(i)).Cells(r, c) = IIf(k < .Item(Tam(i)), "", "=") & Sheets(TH & Tam(i)).Cells(r, c) & "+" & _
"'" & Ws.Cells(r, c).Parent.Name & "'!" & Rng.Address
End If
End If
Next Rng
End If
Next Ws
'Sheets(Sheets.Count).Cells(49, 1) = Timer - Tg
Next i
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
