Doppelte Werte zusammen addieren

Sub Auswerten_der_IA()
Dim myDict1  As Object
Dim WkSh_Q   As Worksheet
Dim WkSh_Z   As Worksheet
Dim vTemp    As Variant
Dim iIndx    As Integer
Dim rZelle   As Range
Set myDict1 = CreateObject("Scripting.Dictionary")
Set WkSh_Q = ThisWorkbook.Worksheets("Zeitprotokoll") ' den Tabellenblattnamen ggf. anpassen! _
Set WkSh_Z = ThisWorkbook.Worksheets("Auswertung") ' den Tabellenblattnamen ggf. anpassen!
'    die Eingabe-Werte in ein Array speichern
vTemp = WkSh_Q.Range("E6:K6" & WkSh_Q.Cells(Rows.Count, 1).End(xlUp).Row)
'    den Array abarbeiten
For iIndx = LBound(vTemp) To UBound(vTemp)
If Trim$(vTemp(iIndx, 1))  "" Then ' ist die Zele nicht leer?
'           in's Dictionary übernehmen und zählen
myDict1(vTemp(iIndx, 1)) = myDict1(vTemp(iIndx, 1)) + Val(vTemp(iIndx, 3))
End If
Next iIndx
'    ausgeben der per Dictionary gesammelten Daten
WkSh_Z.Range("A2:C250").ClearContents ' den Ausgabe-Bereich leeren/löschen
Set rZelle = WkSh_Z.Range("A1")       ' den Ausgabe-Bereich festlegen
rZelle.Resize(myDict1.Count) = WorksheetFunction.Transpose(myDict1.Keys)
rZelle.Offset(0, 2).Resize(myDict1.Count) = WorksheetFunction.Transpose(myDict1.Items)
'    die Bereiche wieder freigeben
Set myDict1 = Nothing
Set WkSh_Q = Nothing
Set WkSh_Z = Nothing
End Sub