Sub Test()
    Dim Sh As Worksheet
    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    LastR = Sh.UsedRange.Row + Sh.UsedRange.Rows.Count - 1
    dx = Sh.Range("A1:P" & LastRow)
    Set C_is = CreateObject("scripting.dictionary")
    For n = 27 To UBound(dx)
        Key$ = dx(n, 5)
        If Key$ = "" Then Exit For

        P = dx(n, 16)
        K = dx(n, 11)
        If C_is.Exists(Key) Then
            A = C_is.Item(Key)
            A(1) = A(1) + K
            A(2) = A(2) + P
            C_is.Item(Key) = A
        Else
            C_is.Item(Key) = Array(n, K, P)
        End If
    Next
    Set C_is = BubbleSort(C_is)
    keys = C_is.keys
    For i = 0 To C_is.Count - 1
        Key = keys(i)
        A = C_is.Item(Key)
        rw& = A(0)
        P = A(2)
        K = A(1)
        LastR = LastR + 5
        Sh.Range("A" & rw).Resize(1, 22).Copy Sh.Range("A" & LastR)
        Sh.Range("K" & LastR) = K
        Sh.Range("P" & LastR) = P
    Next

End Sub

Function BubbleSort(ByVal List)
    If List.Count < 2 Then
        Set BubbleSort = List
        Exit Function
    End If
    keys = List.keys
    Dim First As Long, Last As Long
    Dim i As Long, j As Long
    Dim Temp As String
    First = LBound(keys)
    Last = UBound(keys)
    For i = First To Last - 1
        For j = i + 1 To Last
            If keys(i) > keys(j) Then
                Temp = keys(j)
                keys(j) = keys(i)
                keys(i) = Temp
            End If
        Next j
    Next i
    Set C_is = CreateObject("scripting.dictionary")
    For i = First To Last
        C_is.Item(keys(i)) = List.Item(keys(i))
    Next
    Set BubbleSort = C_is
End Function