Public Sub GPE()
Dim Dic As Object, Col As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim sArr(), dArr(1 To 5000, 1 To 162), I As Long, J As Long, K As Long, C As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("BCC")
sArr = .Range("B6").Resize(, 162).Value
For J = 1 To 162
If sArr(1, J) <> Empty Then
If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
End If
Next J
End With
For Each Ws In Worksheets
If Ws.Name <> "BCC" And Ws.Name <> "N" Then
C = Col.Item(Val(Ws.Name))
sArr = Ws.Range("C9", Ws.Range("C9").End(xlDown)).Resize(, 38).Value
For I = 1 To UBound(sArr)
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
End If
Rws = Dic.Item(Tem)
dArr(Rws, C) = sArr(I, 33)
dArr(Rws, C + 1) = sArr(I, 34): dArr(Rws, C + 2) = sArr(I, 35)
dArr(Rws, C + 3) = sArr(I, 36): dArr(Rws, C + 4) = sArr(I, 38)
Next I
End If
Next Ws
With Sheets("N")
R = .Range("A65536").End(xlUp).Row
If R > 3 Then
sArr = .Range("A3:D" & R).Value
For I = 2 To UBound(sArr)
Tem = sArr(I, 1)
Rws = Dic.Item(Tem)
C = Col.Item(Day(sArr(I, 4)))
dArr(Rws, C) = sArr(I, 3)
Next I
End If
End With
Sheets("BCC").Range("B8").Resize(K, 162) = dArr
Set Dic = Nothing
Set Col = Nothing
End Sub
