@Josef Ehrensberger

Sub DatenHolen()
Dim objSH1 As Worksheet, objSH2 As Worksheet
Dim lngLastRow As Long, lngFirstRow As Long, lngRow As Long, lngIndex As Long, lngMatch As Variant
Dim varArray1 As Variant, varArray2() As Variant, varArray3() As Variant
Set objSH1 = Sheets("Bericht_Daten")
Set objSH2 = Sheets("Auswertung")
lngFirstRow = 5 '--> Startzeile --> anpassen
lngLastRow = objSH1.Range("C65536").End(xlUp).Row
varArray1 = objSH1.Range(objSH1.Cells(lngFirstRow, 3), objSH1.Cells(lngLastRow, 6))
Redim Preserve varArray2(lngIndex)
Redim Preserve varArray3(lngIndex)
For lngRow = 1 To UBound(varArray1, 1)
If lngRow = 1 Then
varArray2(lngIndex) = varArray1(lngRow, 1)
varArray3(lngIndex) = varArray1(lngRow, 4)
Else
lngMatch = Application.Match(varArray1(lngRow, 1), varArray2, 0)
If Not IsNumeric(lngMatch) Then
lngIndex = lngIndex + 1
Redim Preserve varArray2(lngIndex)
Redim Preserve varArray3(lngIndex)
varArray2(lngIndex) = varArray1(lngRow, 1)
varArray3(lngIndex) = varArray1(lngRow, 4)
Else
varArray3(lngMatch - 1) = varArray3(lngMatch - 1) + varArray1(lngRow, 4)
End If
End If
Next
'Ausgabe ab Zeile zwei!
objSH2.Range("A2:A" & UBound(varArray2) + 2) = Application.Transpose(varArray2)
objSH2.Range("B2:B" & UBound(varArray2) + 2) = Application.Transpose(varArray3)
''Soll die Ausgabe zB. erst ab Zeile fünf erfolgen, dann
'objSH2.Range("A5:A" & UBound(varArray2) + 5) = Application.Transpose(varArray2)
'objSH2.Range("B5:B" & UBound(varArray2) + 5) = Application.Transpose(varArray3)
End Sub