Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integernr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).RowName = "A:A"
Jan = "B:B"
Dim y As LongFor i = 2 To nr
    Value = Worksheets("Sheet2").Range("A" & i)
    y = 0
    On Error Resume Next
        y = WorksheetFunction.Match(Value, Worksheets("Sheet1").Range(Name), 0)
    On Error GoTo 0
    If y = 0 Then
        Range("B" & i) = 0
    Else
        Range("B" & i) = WorksheetFunction.Sum(Worksheets("Sheet1").Rows(y))
    End If
    'Range("B" & i) = WorksheetFunction.SumIf(Worksheets("Sheet1").Range(Name), Value, Worksheets("Sheet1").Range(Jan))
Next i
End Sub

Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integer

nr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).RowName = "A:A"
Jan = "B:B"
Dim y As Variant
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim a As VariantWith Worksheets("Sheet1")
    a = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
End WithFor y = 2 To UBound(a, 1)
    If Not dic.Exists(a(y, 1)) Then Set dic.Item(a(y, 1)) = CreateObject("Scripting.Dictionary")
    dic.Item(a(y, 1)).Item(y) = y
Next
For i = 2 To nr
    Value = Worksheets("Sheet2").Range("A" & i)
    Range("B" & i) = 0
    If dic.Exists(Value) Then
        For Each y In dic.Item(Value).Keys
            Range("B" & i) = Range("B" & i) + WorksheetFunction.Sum(Worksheets("Sheet1").Rows(y))
        Next
    End If
Next i
End Sub