Modifier code Somme de sous ensemble

Sub ChercheSomme()
Dim Tableau() As Double, Plage As Range, Cel As Range
Dim Boucle As Integer, NbSol As Long, K As Integer
Dim TabCombin, Boucle2 As Integer, Montant As Double
Dim NbVal As Integer, Mini As Integer, Maxi As Integer

  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False

    With F4
      Set Plage = .Range("BaseDep", .Range("BaseDep").End(xlDown))
      Set Cel = .Range("Sol1")
      Range(Cel, Cel.End(xlDown)).Resize(, 200).ClearContents
      Montant = .Range("Montant")
      DetermineMinMax .Range("NbValeurs"), Mini, Maxi, Plage.Rows.Count
    End With

    ReDim Tableau(1 To Plage.Rows.Count)
    For Boucle = 1 To Plage.Rows.Count
      Tableau(Boucle) = Plage.Cells(Boucle, 1)
    Next Boucle

    For K = Mini To Maxi
      DoEvents
      TabCombin = SommeKSurN(Tableau, K, Montant)
      If IsArray(TabCombin) Then
        For Boucle = LBound(TabCombin, 2) To UBound(TabCombin, 2)
          NbSol = NbSol + 1
          Cel = NbSol
          For Boucle2 = 1 To K
            Cel.Offset(0, Boucle2) = TabCombin(Boucle2, Boucle)
          Next Boucle2
          Set Cel = Cel.Offset(1, 0)
          Exit Sub
        Next Boucle
      End If
    Next K
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
End Sub