Remplacement formules par un code VBA

bonjour,

je reviens vers vous pour un souci que je n'arrive pas à régler seul depuis le matin.

les données de la colonne F de la feuille entrées sont des fois incorrectes donc je voulais plutôt faire l'addition en colonne K selon code article et multiplier par sa ligne en colonne D de la feuille DONNEES..

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sWk1 As Worksheet, sWk2 As Worksheet

Dim lRow!, lRow1!, lRow2!

Set sWk1 = Worksheets("MVTS")

Set sWk2 = Worksheets("DONNEESS")

Application.EnableEvents = False

Application.ScreenUpdating = False

lRow = Target.Row

On Error Resume Next

If Not Intersect(Target, Range("K:K")) Is Nothing And Cells(lRow, 1) > 0 And Cells(lRow, 9) > 0 Then

lRow1 = Range("A:A").Find(what:=Cells(lRow, 1), lookat:=xlWhole, searchdirection:=xlNext).Row

lRow2 = Range("A:A").Find(what:=Cells(lRow, 1), lookat:=xlWhole, searchdirection:=xlPrevious).Row

sWk.Cells(sWk.Range("B:B").Find(what:=Cells(lRow, 9), lookat:=xlWhole).Row + 1, 4 + Cells(lRow, 1)) = _

WorksheetFunction.SumIfs(Range("K" & lRow1 & ":K" & lRow2), Range("I" & lRow1 & ":I" & lRow2), Cells(lRow, 9)) * _

sWk2.Range("A:A").Find(what:=Cells(lRow, 9), lookat:=xlWhole).Offset(0, 3)

End If

On Error GoTo 0

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

je n'ai aucun résultat.

merci d'avance pour votre aide.

Moutchec.

Bonjour,

Pour commencer :

Dim lRow As Long, lRow1 As Long, lRow2 As Long

Ensuite, modifie en en mettant le bon nom de feuille :

sWk.Cells(sWk.Range("B:B").Find(what:=Cells(lRow, 9), lookat:=xlWhole).Row + 1, 4 + Cells(lRow, 1))

Cdlt.

re, j'ai des résultats 0 .

ça l'air de fonctionner avec ceci :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sWk1 As Worksheet, sWk2 As Worksheet

Dim lRow As Long, lRow1 As Long, lRow2 As Long

Set sWk1 = Worksheets("MVTS")

Set sWk2 = Worksheets("DONNEES")

Application.EnableEvents = False

Application.ScreenUpdating = False

lRow = Target.Row

On Error Resume Next

If Not Intersect(Target, Range("F:F")) Is Nothing And Cells(lRow, 1) > 0 And Cells(lRow, 9) > 0 Then

lRow1 = Range("A:A").Find(what:=Cells(lRow, 1), lookat:=xlWhole, searchdirection:=xlNext).Row

lRow2 = Range("A:A").Find(what:=Cells(lRow, 1), lookat:=xlWhole, searchdirection:=xlPrevious).Row

sWk1.Cells(sWk1.Range("B:B").Find(what:=Cells(lRow, 9), lookat:=xlWhole).Row + 1, 4 + Cells(lRow, 1)) = _

WorksheetFunction.SumIfs(Range("K" & lRow1 & ":K" & lRow2), Range("I" & lRow1 & ":I" & lRow2), Cells(lRow, 9)) * _

sWk2.Range("A:A").Find(what:=Cells(lRow, 9), lookat:=xlWhole).Offset(0, 3)

End If

On Error GoTo 0

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

j'ai juste bougé la position des parenthèses!