Soustraction entre deux feuilles
Salut les amis,
J'ai ce code pour faire une soustraction entre deux feuilles en VBA avec condition, j'ai remarqué que ce code s'exécute ligne par ligne et je veux le modifier.
Sub Deduire()
Dim f1 As Worksheet, f2 As Worksheet
Dim DerLig_f1 As Long, DerLig_f2 As Long, i As Long
Dim q As Range
Application.ScreenUpdating = False
Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
DerLig_f2 = f2.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To DerLig_f1
Lot = f1.Cells(i, "A")
Set q = f2.Range("E1:E" & DerLig_f2).Find(Lot, lookat:=xlWhole)
If Not q Is Nothing Then
If f1.Cells(i, "E") - f2.Cells(q.Row, "C") < 0 Then
MsgBox "Quantité insuffisante " & f1.Cells(i, "A") & " déduction non réalisée"
Else
f1.Cells(i, "E") = f1.Cells(i, "E") - f2.Cells(q.Row, "C")
End If
End If
Next i
Set q = Nothing
Set f1 = Nothing
Set f2 = Nothing
End Subje veux que ce code s'exécute sur toutes les lignes ou bien ne s'exécute sur aucun ligne et me montre le message d'erreur déjà indiqué
Merci
Bonsoir xxmedxx
Pourquoi faire ce genre d'opération en VBA
Sinon sans fichier, ça ne va pas être simple de vous aider
A+
Merci pour votre réponse, j'ai résolu le problème
Sub Deduire_Quantite()
Dim f1 As Worksheet, f2 As Worksheet
Dim DerLig_f1 As Long, DerLig_f2 As Long, i As Long
Dim q As Range
Application.ScreenUpdating = False
Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
DerLig_f2 = f2.Range("E" & Rows.Count).End(xlUp).Row
'1er passage de contrôle
For i = 2 To DerLig_f1
Lot = f1.Cells(i, "A")
Set q = f2.Range("E1:E" & DerLig_f2).Find(Lot, lookat:=xlWhole)
If Not q Is Nothing Then
If f1.Cells(i, "E") - f2.Cells(q.Row, "C") < 0 Then
MsgBox "Quantité insuffisante pour le lot " & f1.Cells(i, "A") & " Abandon"
Exit Sub
End If
End If
Next i
'2ème passage si le contrôle est satisfaisant
For i = 2 To DerLig_f1
Lot = f1.Cells(i, "A")
Set q = f2.Range("E1:E" & DerLig_f2).Find(Lot, lookat:=xlWhole)
If Not q Is Nothing Then f1.Cells(i, "E") = f1.Cells(i, "E") - f2.Cells(q.Row, "C")
Next i
Set q = Nothing
Set f1 = Nothing
Set f2 = Nothing
End SubMon fichier est très compliqué il faut pas toucher au feuilles, toutes les manipulations sont guidés par VBA, il est relié avec 3 autres fichiers en réseau local et tout fichier contient plusieurs feuilles.
En résumé Bruno, donner accès au feuilles avec des formules simples, c'est risqué même avec la protection.
j'espere que ma réponse est satisfaisante.