Copier / coller ligne suivant résultat.

DAVID-44-

XLDnaute Occasionnel
Bonjour,
j'ai créé une macro afin de copier/coller, suivant un résultat, une ligne dans la feuille "STOCK".
Malheureusement, j'ai deux soucis. J'aimerais que cette macro fonctionne sur toutes les lignes (9 à 19; 24 à 34; 39 à 49; etc).
le deuxième souci est que je souhaiterais que cette macro ne fonctionne pas si le résultat dans la colonne "M" n'est pas supérieur à zéro.
Au cas où, si vous avez une autre solution pour le résultat souhaité, je suis preneur...
Merci beaucoup de votre aide.
 

Pièces jointes

  • STOCK. 2..xlsm
    134 KB · Affichages: 13

job75

XLDnaute Barbatruc
Bonjour DAVID-44-,
VB:
Sub copier_coller_ligne_suivant_calcul()
Dim i&
For i = Range("G" & Rows.Count).End(xlUp).Row To 9 Step -1
    If Val(Cells(i, 7)) - Val(Cells(i, 5)) > 0 Then
        Rows(i + 1).Insert
        Rows(i).Copy Rows(i + 1)
        Cells(i + 1, 5) = ""
        Cells(i + 1, 7) = Val(Cells(i, 7)) - Val(Cells(i, 5))
    End If
Next
End Sub
A+
 

job75

XLDnaute Barbatruc
Une solution plus élaborée pour éviter d'insérer de nouveau des lignes si on relance la macro :
VB:
Sub copier_coller_ligne_suivant_calcul()
Dim dercol%, i&, sup As Boolean, j%
dercol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
Application.ScreenUpdating = False
For i = Range("G" & Rows.Count).End(xlUp).Row To 9 Step -1
    If Val(Cells(i, 7)) - Val(Cells(i, 5)) > 0 And Cells(i, 5) > 0 Then
        Rows(i + 1).Insert 'insère une ligne
        Rows(i).Copy Rows(i + 1)
        Cells(i + 1, 5) = ""
        Cells(i + 1, 7) = Val(Cells(i, 7)) - Val(Cells(i, 5))
        sup = True
        For j = 1 To dercol
            If Cells(i + 1, j) <> Cells(i + 2, j) Then sup = False: Exit For
        Next
        If sup Then Rows(i + 1).Delete 'supprime la ligne insérée
    End If
Next
End Sub
 

Pièces jointes

  • STOCK. 2(1)..xlsm
    148.1 KB · Affichages: 4

DAVID-44-

XLDnaute Occasionnel
Vous êtes génial!
Merci beaucoup.
Juste une dernière question, quand le calcul est composé avec des chiffres avec des virgules, le résultat est arrondi. Est-il possible d'avoir le bon résultat pas arrondi, mais avec la virgule ?

Aussi est-il possible dans le résultat de la ligne "ajoutée" de supprimer les annotations dans les cellules "F" ?

Merci encore.
 
Dernière édition:

job75

XLDnaute Barbatruc
Fichier (2) avec la macro complétée :
VB:
Sub copier_coller_ligne_suivant_calcul()
Dim dercol%, i&, v#, sup As Boolean, j%
dercol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
Application.ScreenUpdating = False
For i = Range("G" & Rows.Count).End(xlUp).Row To 9 Step -1
    v = Val(Replace(Cells(i, 7), ",", ".")) - Val(Replace(Cells(i, 5), ",", "."))
    If v > 0 And Cells(i, 5) > 0 Then
        Rows(i + 1).Insert 'insère une ligne
        Rows(i).Copy Rows(i + 1)
        Cells(i + 1, 6).Validation.Delete 'supprime la liste de validation
        Cells(i + 1, 5) = ""
        Cells(i + 1, 7) = v
        sup = True
        For j = 1 To dercol
            If Cells(i + 1, j) <> Cells(i + 2, j) Then sup = False: Exit For
        Next
        If sup Then Rows(i + 1).Delete 'supprime la ligne insérée
    End If
Next
End Sub
En colonne F les "annotations" sont en fait des listes de validation.
 

Pièces jointes

  • STOCK. 2(2).xlsm
    148.5 KB · Affichages: 3

Discussions similaires

Réponses
6
Affichages
266

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal