Sammenkædning og summering af data

Rem Version 2 - optælling pr. PartName
Rem ==================================
Const optællingsArk = "DATAARK Pareto"
Const dataArk = "DATAARK"

Dim antalRæk, fRække, dArk As Worksheet, optælArk As Worksheet, del2Start
Sub PartsOptælling(slutRæk)
Dim pNavn, pDato As Date, pMisP, insFail, visionFail
Dim kol

    del2Start = slutRæk
   
Rem def. ark
    Set dArk = ActiveWorkbook.Sheets(dataArk)
    Set optælArk = ActiveWorkbook.Sheets(optællingsArk)
       
Rem dataArk aktiveres
    dArk.Activate
   
Rem Find antal rækker i arket
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
Rem startRække i optællingsarket
    fRække = del2Start
   
    Application.ScreenUpdating = False
   
Rem Traverser Arket pr række i range X - CE
   
    For ræk = 2 To antalRæk
        kol = Range("X2").Column
   
        For x = 1 To 15
            pNavn = Cells(ræk, kol)                                    'PartName kol

Rem afbryd række, hvis pNavn er ej udfyldt
            If pNavn = "" Then
                Exit For
            End If
           
            pDato = Format(Cells(ræk, 2), "dd-mm-yyyy")            'B -
            pMisP = Cells(ræk, kol + 1)                            'MisPicked
            insFail = Cells(ræk, kol + 2)                          'Ins Fail.
            visionFail = Cells(ræk, kol + 3)                        'Vision Fail.
           
            optælFejl pNavn, pDato, pMisP, insFail, visionFail
            kol = kol + 4
        Next x
    Next ræk

    Application.ScreenUpdating = True
End Sub
Private Sub optælFejl(pNavn, pDato, pMisP, insFail, visionFail)
Dim pRæk
    pRæk = findesPnavnPdato(pNavn, pDato)
   
    If pRæk = 0 Then
        pRæk = fRække
        fRække = fRække + 1
    End If
   
    With optælArk
        .Cells(pRæk, 1) = pNavn
        .Cells(pRæk, 2) = pDato
        .Cells(pRæk, 3) = .Cells(pRæk, 3) + pMisP
        .Cells(pRæk, 4) = .Cells(pRæk, 4) + insFail
        .Cells(pRæk, 5) = .Cells(pRæk, 5) + visionFail
    End With
End Sub
Private Function findesPnavnPdato(pNavn, pDato)
    With optælArk
        For ræk = del2Start To fRække
            If LCase(.Cells(ræk, 1)) = LCase(pNavn) And .Cells(ræk, 2) = pDato Then
                findesPnavnPdato = ræk
                Exit Function
            End If
        Next
    End With
    findesPnavnPdato = 0
End Function

sikke en kode, kan en simpel pivottabel ikke klare det?

Sikkert. Hvor finder jeg den og hvordan benyttes den?