SUMIF3D(ByVal sum_range As Range, ByVal list_Sheets As String, ByVal criteriaRange As Range, ByVal criteria As Variant, Optional ByVal isNumeric As Boolean = False)

=SUMIF3D(D1:D5,"sheet1,sheet2",H1:H5,I1)

Sheet1!D1:D5 = 1-5
Sheet2!D1:D5 = 10-50
Sheet1!H1:H5 = 1,5,10,15,20

Option Explicit

Public Function SUMIF3D(ByVal sum_range As Range, ByVal list_Sheets As String, ByVal criteriaRange As Range, ByVal criteria As Variant, Optional ByVal isNumeric As Boolean = False) As Long
    Const OPERATORS As String = ">,<,<>,="
    Dim isPossible As Boolean
    Dim toSum() As Boolean
    Dim i As Long
    Dim j As Long

    Dim sumRangeCells() As Long
    ReDim sumRangeCells(1 To sum_range.Count, 1 To 2)
    Dim cell As Range
    i = 1
    For Each cell In sum_range
        sumRangeCells(i, 1) = cell.Row
        sumRangeCells(i, 2) = cell.Column
        i = i + 1
    Next

    Dim numberOfCells As Long
    Dim sheetsArray As Variant
    sheetsArray = Split(list_Sheets, ",")
    Dim sumRangeArray As Variant
    numberOfCells = (UBound(sheetsArray) + 1) * sum_range.Count
    ReDim sumRangeArray(1 To numberOfCells)

    Dim k As Long
    k = 1
    For i = LBound(sheetsArray) To UBound(sheetsArray)
        For j = 1 To sum_range.Count
            sumRangeArray(k) = Sheets(sheetsArray(i)).Cells(sumRangeCells(j, 1), sumRangeCells(j, 2))
            k = k + 1
        Next
    Next

    Dim critRangeArray As Variant
    critRangeArray = criteriaRange.Value2
    Dim criteriaArray As Variant
    criteriaArray = criteria.Value2

    ReDim toSum(1 To UBound(critRangeArray, 1))
    If Not IsArray(criteriaArray) Then
        If IsEmpty(criteriaArray) Then
            isPossible = False
        Else: isPossible = True
        End If
    Else
        If Not UBound(criteriaArray, 1) = UBound(critRangeArray, 1) Then
            isPossible = False
        Else: isPossible = True
        End If
    End If

    If Not isPossible Then Exit Function

    Select Case isNumeric
        Case 1
            If IsArray(criteriaArray) Then
                For i = 1 To UBound(critRangeArray)
                    If InStr(1, OPERATORS, Left$(criteriaArray(i, 1), 1)) > 0 Then
                        toSum(i) = Application.Evaluate(critRangeArray(i, 1) & criteriaArray(i, 1))
                    Else: toSum(i) = critRangeArray(i, 1) = criteriaArray(i, 1)
                    End If
                Next
            Else
                For i = 1 To UBound(critRangeArray)
                        If InStr(1, OPERATORS, Left$(criteriaArray, 1)) > 0 Then
                            toSum(i) = Application.Evaluate(critRangeArray & criteriaArray)
                        Else: toSum(i) = critRangeArray(i, 1) = criteriaArray
                        End If
                Next
            End If
        Case 0
            If IsArray(criteriaArray) Then
                For i = 1 To UBound(critRangeArray)
                    toSum(i) = critRangeArray(i, 1) = criteriaArray(i, 1)
                Next
            Else
                For i = 1 To UBound(critRangeArray)
                    toSum(i) = critRangeArray(i, 1) = criteriaArray
                Next
            End If
    End Select

    For j = LBound(sheetsArray) To UBound(sheetsArray)
        For i = 1 To UBound(toSum)
            If toSum(i) Then SUMIF3D = SUMIF3D + sumRangeArray(i + j * UBound(toSum))
        Next
    Next
End Function