Option Explicit
Public Sub GPE()
Dim Arr, dArr, I As Long, J As Long, K As Long, X As Long
Dim ShMau As Worksheet, ShDs As Worksheet, Wb As Workbook
Dim Dic As Object, Tem As String
Application.ScreenUpdating = False
Set Wb = ActiveWorkbook
Set ShMau = Wb.Sheets("Mau DS_TheoLop")
Set ShDs = Wb.Sheets("Danh sach")
Arr = ShDs.Range("A2", ShDs.Range("A2").End(4)).Resize(, 12).Value2
ReDim dArr(1 To UBound(Arr), 1 To 11)
Set Dic = CreateObject("Scripting.Dictionary")
ShMau.Copy
For I = 1 To UBound(Arr)
Tem = Arr(I, 8)
If Not Dic.exists(Tem) Then
Dic.Add Tem, ""
ActiveSheet.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Tem
K = 0
For X = 1 To UBound(Arr)
If Arr(X, 8) = Tem Then
K = K + 1
dArr(K, 1) = K
For J = 2 To 6
dArr(K, J) = Arr(X, J + 1)
Next J
dArr(K, 7) = Arr(X, 1)
For J = 8 To 11
dArr(K, J) = Arr(X, J + 1)
Next J
End If
Next X
.Rows("9:" & K + 6).Insert Shift:=xlDown
.Range("A9").Resize(K, 11).Value = dArr
.Range("A5").Value = "L" & ChrW(7899) & "p: " & Tem
.Range("A9").Resize(K, 11).Font.Name = "Times New Roman"
.Range("A9").Resize(K, 11).Font.Size = 13
.Range("A9").Resize(K, 11).Font.ColorIndex = xlAutomatic
.Range("E9").Resize(K).NumberFormat = "dd/mm/yyyy"
.Range("A9").Resize(K, 11).HorizontalAlignment = xlCenter
.Range("A9").Resize(K, 11).VerticalAlignment = xlCenter
.Range("C9").Resize(K, 2).HorizontalAlignment = xlLeft
.Range("C9").Resize(K, 2).VerticalAlignment = xlCenter
End With
End If
Sheets(1).Activate
Next I
Sheets(1).Delete
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub