Supprimer lignes suivant critères dans deux onglets[Résolu]

fenec

XLDnaute Impliqué
Bonsoir le forum,

Vous expose ma dernière requête :

Grace à l’aide de Job75 j’insère des lignes en fonction d’un critère et copie des valeurs dans une autre feuille, c’est nickel (merci Job75)
Pour finaliser mon projet j’aimerais supprimer les lignes qui du fait de l’insertion ne me servent plus.
Suis parvenue à faire un code pour les supprimer mais seulement dans une feuille.
Ma demande est donc :
Est-il possible de la faire fonctionner pour les deux feuilles ?
Le top serait même de l’insérer dans le code de Job75 plutôt que d’être obliger de l’appeler en fin de procédure.

Ci-joint fichier avec le code de Job75 et le code que je suis parvenu à réaliser.

Cordialement

Philippe
 

Pièces jointes

  • Supprimer lignes.xls
    539.5 KB · Affichages: 30
  • Supprimer lignes.xls
    539.5 KB · Affichages: 35
  • Supprimer lignes.xls
    539.5 KB · Affichages: 30
Dernière édition:

job75

XLDnaute Barbatruc
Re : Supprimer lignes suivant critères dans deux onglets

Re,

S'il s'agit uniquement de supprimer chacune des lignes sources copiée :

Code:
Sub Mise_à_Jour5()
Dim a, code, n As Byte, c, cel As Range, memcel As Range
a = Array(Feuil1, Feuil2) 'CodeNames des feuilles à traiter
code = Array("D712", "D727") 'codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For n = 0 To UBound(a)
    Set cel = a(n).[B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
    If Not cel Is Nothing Then
      cel(2).EntireRow.Insert 'ligne entière
      cel.Resize(, 12).Copy cel(2)
      cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
      cel(2, 4) = IIf(n, DateAdd("yyyy", 1, cel(2, 4)), a(1).Cells(cel(2).Row - 1, "M"))
      cel(2, 5) = IIf(n, DateAdd("yyyy", 1, cel(2, 5)), 0)
      If n Then cel.EntireRow.Delete Else Set memcel = cel 'mémorise si 1ère feuille
    End If
  Next
  'suppression différée sur la 1ère feuille :
  If Not memcel Is Nothing Then memcel.EntireRow.Delete: Set memcel = Nothing
Next
End Sub
A+
 
Dernière édition:

fenec

XLDnaute Impliqué
Re : Supprimer lignes suivant critères dans deux onglets

Bonsoir le forum,Job75

Venant poster un fichier avec plusieurs lignes comme vous le demandiez ce matin je découvre votre code.
Je le teste et il correspond à ce que je désirais mais suite à votre demande de fichier il est vrai que si l’avant dernière ligne de chaque critère n’est pas supprimé cela permet de vérifier que le solde a bien été reporté dans la ligne insérée.

Vous allez me dire que je complique encore les choses mais vos remarques sont pertinentes, par conséquent (sans vouloir abuser) :
Serait-il possible peut être avec une condition "date" de ne supprimer que les lignes antérieures à l’avant dernière de chaque critères tous les 4 ans par exemple ?
Je ne sais pas si je suis clair…

Ci-joint fichier avec x lignes, j’ai mis les lignes à supprimer d’une autre couleur dans les deux onglets

Cordialement

Philippe
 

Pièces jointes

  • Supprimer lignes2.xls
    609 KB · Affichages: 38

job75

XLDnaute Barbatruc
Re : Supprimer lignes suivant critères dans deux onglets

Re fenec,

Avec cette macro, les lignes qui précèdent les 2 dernières de chaque code sont supprimées :

Code:
Sub Mise_à_Jour5()
Dim a, code, n As Byte, c, cel As Range, i&
a = Array(Feuil1, Feuil2) 'CodeNames des feuilles à traiter
code = Array("D712", "D727") 'codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For n = 0 To UBound(a)
    Set cel = a(n).[B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
    If Not cel Is Nothing Then
      cel(2).EntireRow.Insert 'ligne entière
      cel.Resize(, 12).Copy cel(2)
      cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
      cel(2, 4) = IIf(n, DateAdd("yyyy", 1, cel(2, 4)), a(1).Cells(cel(2).Row - 1, "M"))
      cel(2, 5) = IIf(n, DateAdd("yyyy", 1, cel(2, 5)), 0)
      i = Application.Match(c, a(n).[B:B], 0)
      For i = cel(0).Row To i Step -1
        If a(n).Cells(i, 2) = c Then a(n).Rows(i).Delete
      Next
    End If
  Next
Next
End Sub
A+
 

fenec

XLDnaute Impliqué
Re : Supprimer lignes suivant critères dans deux onglets

Re le forum,Job75

Viens de tester c’est super, vous êtes le roi du VBA.
Me reste à réussir à comprendre cette parti de votre code, je ne connais pas "application match" alors avec (c, a(n) je suis perdu pouvais vous m’éclairez que je comprenne

Code:
i = Application.Match(c, a(n).[B:B], 0)
       For i = cel(0).Row To i Step -1
         If a(n).Cells(i, 2) = c Then a(n).Rows(i).Delete

je reviens en cas de soucis dans mon fichier final si vous permettez et suis à l'écoute de vos expliquations.

Cordialement

Philippe
 

Discussions similaires

Réponses
2
Affichages
554

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG