Modification code VBA en boucle

bonjour

j'ai essayée de faire un code SUMIFS avec VBA mais il est très long .

vous pouvez m'aider de faire en boucle svp

merci

Sub SumIfs()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim arrE As Variant, arrH As Variant, arrF As Variant

Dim lr As Long, i As Long

'Dim dt1 As Date, dt2 As Date

Dim Sum As Double, Sum1 As Double

Dim Sum2 As Double, Sum3 As Double

Dim Sum4 As Double, Sum5 As Double, Sum6 As Double

Set ws1 = ThisWorkbook.Worksheets("Conclusion")

Set ws2 = ThisWorkbook.Worksheets("Database")

With ws2

lr = .Cells(.Rows.Count, "F").End(xlUp).Row

arrE = .Range("E2:E" & lr)

arrF = .Range("F2:F" & lr)

For i = 1 To UBound(arrF)

If arrE(i, 1) = ws1.Range("F5").Value Then

Sum = Sum + arrF(i, 1)

ElseIf arrE(i, 1) = ws1.Range("F6").Value Then

Sum1 = Sum1 + arrF(i, 1)

ElseIf arrE(i, 1) = ws1.Range("F7").Value Then

Sum2 = Sum2 + arrF(i, 1)

ElseIf arrE(i, 1) = ws1.Range("F8").Value Then

Sum3 = Sum3 + arrF(i, 1)

ElseIf arrE(i, 1) = ws1.Range("F9").Value Then

Sum4 = Sum4 + arrF(i, 1)

ElseIf arrE(i, 1) = ws1.Range("F10").Value Then

Sum5 = Sum5 + arrF(i, 1)

ElseIf arrE(i, 1) = ws1.Range("F11").Value Then

Sum6 = Sum6 + arrF(i, 1)

End If

Next

End With

ws1.Range("G5").Value = Sum

ws1.Range("G6").Value = Sum1

ws1.Range("G7").Value = Sum2

ws1.Range("G8").Value = Sum3

ws1.Range("G9").Value = Sum4

ws1.Range("G10").Value = Sum5

ws1.Range("G11").Value = Sum6

'MsgBox (Sum)

'MsgBox (Sum1)

End Sub

Slt richi2casa,

à tester:

Sub SumIfs()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim arrE As Variant, arrF As Variant
    Dim lr As Long, i As Long, j As Long
    Dim Sum As Double

    Set ws1 = ThisWorkbook.Worksheets("Conclusion")
    Set ws2 = ThisWorkbook.Worksheets("Database")

  With ws2
        lr = .Cells(.Rows.Count, "F").End(xlUp).Row
        arrE = .Range("E2:E" & lr)
        arrF = .Range("F2:F" & lr)

        For j = 5 To 11
                For i = 1 To UBound(arrF)
                    If arrE(i, 1) = ws1.Range("F" & j).Value Then
                        Sum = Sum + arrF(i, 1)
                     End If
                 Next i
         ws1.Range("G" & j).Value = Sum
         Sum = 0
        Next j
    End With
End Sub

BONJOUR

MERCI BIEN

RÉSOLUT