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 Sub

je 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 Sub

Mais vous n'avez pas répondu à ma question

Mais bon on s'en fou hein

Mon 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.

Rechercher des sujets similaires à "soustraction entre deux feuilles"