Public Sub GPE()
Dim Dic As Object, sArr(), Ws As Worksheet, i As Integer, Rng1 As Range, Rng2 As Range, n As Long
Application.ScreenUpdating = False
sArr() = Sheets("Tong hop").Range("B4:F" & Sheets("Tong hop").Range("A65000").End(xlUp).Row).Value
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Tong hop")
.Range("N1").Value = .Range("B3").Value
Set Rng1 = .Range("A65000").End(xlUp).Offset(1).Resize(7, 6)
For i = 1 To UBound(sArr, 1)
If Not Dic.exists(sArr(i, 1)) Then
Dic.Add sArr(i, 1), ""
.Range("N2").Value = sArr(i, 1)
If WsExit(sArr(i, 1)) Then
Set Ws = Sheets(sArr(i, 1))
Ws.UsedRange.Clear
Else
Set Ws = Worksheets.Add(, Sheets("Tong hop"))
End If
Ws.Name = sArr(i, 1)
.Range("A3:F" & .Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("N1:N2"), CopyToRange:=Ws.Range("A3:F3"), Unique:=False
Ws.Range("A4:A" & Ws.Range("A65000").End(xlUp).Row).Value = [row(r:r)]
Ws.Range("A1:F1").Merge: Ws.Range("A2:F2").Merge
Ws.Range("A1:F1").HorizontalAlignment = xlCenter
Ws.Range("A1:F1").VerticalAlignment = xlCenter
Ws.Range("A2:F2").HorizontalAlignment = xlCenter
Ws.Range("A2:F2").VerticalAlignment = xlCenter
Ws.Range("A1").Value = .Range("B1").Value
Ws.Range("A2").Value = sArr(i, 1)
Ws.Range("A65000").End(xlUp).Offset(1, 3).Value2 = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
Ws.Range("A65000").End(xlUp).Offset(1, 4).Formula = "=SUM(R[" & -(Ws.Range("A65000").End(xlUp).Row - 3) & "]C:R[-1]C)"
Ws.Range("A65000").End(xlUp).Offset(1).Resize(, 6).Borders.LineStyle = 1
Ws.Columns("A:F").EntireColumn.AutoFit
Set Rng2 = Ws.Range("A65000").End(xlUp).Offset(2)
Rng1.Copy Rng2
End If
Next i
.Range("N1:N2").ClearContents
End With
Dim Wb As Workbook
Sheets(Dic.Keys).Move
'Set Wb = ActiveWorkbook
'Wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Sheets(1).Name & ".xls", FileFormat:=52
'Wb.Close False
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox "Da xuat xong"
End Sub
Public Function WsExit(ByVal wsName As String) As Boolean
On Error Resume Next
WsExit = CBool(Len(Worksheets(wsName).Name) > 0)
End Function