copier et insérer ligne suivant valeur

[KOGITUS]

Bonjour,

Je boucle sur une plage et lorsque je trouve la valeur A je copie la ligne et je l'insère en dessous.
Je me suis inspiré d'un code trouvé sur le net.
Je ne sais pas comment passer 2 ligne dans la boucle ci-dessous pour continuer la recherche :

Sub CopieLigne()
    Dim plage As Range
    Dim cel As Range
    Dim Recherche
    
    Recherche = "A"
    With Worksheets("Feuil1")
        derlig = .Range("L" & Rows.Count).End(xlUp).Row
        Set plage = .Range("L2:L" & derlig)
    End With
    
    For Each cel In plage
        If cel = Recherche Then
        prix = cel.Offset(0, 2).Value
        cel.Offset(0, 2).Value = 150
        prix = prix - 150
            cel.EntireRow.Copy
            cel.Offset(0, -11).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
            cel.Offset(0, 2).Value = prix


            'cel = cel + 2 ???????
            
        End If
    Next cel
End Sub

Savez-vous comment ajouter 2 à "cel" pour passer une ligne SVP ?

Merci d'avance pour votre aide

 

[Paf]

Re : copier et insérer ligne suivant valeur

Bonjour,

a priori il faudra passer par une boucle indicée et commencer par la fin et 'remonter' pour ne pas avoir de soucis avec la ligne insérée.

une modification a minima, pas testée faute de support:

Sub CopieLigne()
    Dim plage As Range
    Dim cel As Range
    Dim Recherche
    Dim i as Long
   
    Recherche = "A"
    With Worksheets("Feuil1")
        derlig = .Range("L" & Rows.Count).End(xlUp).Row
       ' Set plage = .Range("L2:L" & derlig)

   
    For i= derlig to 2 step -1 'Each cel In plage
        cel = .Cells(i,12)
        If cel = Recherche Then
        prix = cel.Offset(0, 2).Value
        cel.Offset(0, 2).Value = 150
        prix = prix - 150
            cel.EntireRow.Copy
            cel.Offset(0, -11).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
            cel.Offset(0, 2).Value = prix


            'cel = cel + 2 ???????
           
        End If
    Next cel
    End With
End Sub

A+

 

[KOGITUS]

Re : copier et insérer ligne suivant valeur

Bonjour Paf,

Merci d'avoir pris le temps de regarder mon problème.

Dés que je lance ta Macro j'ai un message d'erreur sur Next cel : "Erreur de compilation, référence de variable de contrôle incorrecte dans next." ?

Merci.

 

[KOGITUS]

Re : copier et insérer ligne suivant valeur

Finalement en bidouillant j'ai trouvé ça :

Sub CopieLigne()
Dim plage As Range
Dim cel As Range
Dim Recherche
Dim i As Long
           
Recherche = "A"
With Worksheets("Feuil1")
    derlig = .Range("L" & Rows.Count).End(xlUp).Row
End With
           
For i = 2 To derlig Step 1
                 
    If Cells(i, 12).Value = Recherche Then
    prix = Cells(i, 12).Offset(0, 2).Value
    Cells(i, 12).Offset(0, 2).Value = 150
    prix = prix - 150
    Cells(i, 12).EntireRow.Copy
    Cells(i, 12).Offset(0, -11).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Cells(i, 12).Offset(0, 2).Value = prix
    i = i + 1

    End If

Next i

End Sub

Il doit y avoir mieux mais cela fonctionne

Merci Paf, tu m'as mis sur la bonne voie
@+

 

[Paf]

Re : copier et insérer ligne suivant valeur

re,

next cel en erreur , normal il n'y avait pas de for cel mais for i. c'est tout le problème de ne pouvoir tester les propositions sur un jeu d'essai.

la méthode choisie risque d'oublier des lignes:

prenons comme exemple une liste de données de L2 à L20, à chaque itération on insère une ligne si le test est vrai. En supposant que le test soit vrai 4 fois, on va rajouter 4 lignes.

les données initialement en ligne 20 seront donc décalées en 24 ( et sans doute d'autres lignes) mais comme i est limité à la dernière ligne de données initiale (20) elles ne seront pas traitées.

une solution consiste à commencer par le bas , si i = 20 , on insère en ligne 21, puis i passe à 19, on insère en 20 etc...

A+

 

[KOGITUS]

Re : copier et insérer ligne suivant valeur

Effectivement Paf, je viens de me rendre compte de l'erreur.

J'ai repris votre code mais je bute toujours.
J'ai remplacé Next Cel par Next i et j'ai un autre message sur cette ligne "cel = .Cells(i, 12)".
Erreur d'exécution 91 variable objet ou variable de bloc with non définie
J'ai remplacé les "cel" par "cells(i,12)" et on dirait bien que ça fonctionne.

Sub CopieLignebis()
    Dim plage As Range
    Dim cel As Range
    Dim Recherche
    Dim i As Long
   
    Recherche = "A"
    With Worksheets("Feuil1")
        derlig = .Range("L" & Rows.Count).End(xlUp).Row
  
    For i = derlig To 2 Step -1 'Each cel In plage
        If Cells(i, 12).Value = Recherche Then
        prix = Cells(i, 12).Offset(0, 2).Value
        Cells(i, 12).Offset(0, 2).Value = 150
        prix = prix - 150
            Cells(i, 12).EntireRow.Copy
            Cells(i, 12).Offset(0, -11).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False
            Cells(i, 12).Offset(0, 2).Value = prix


        End If
    Next i
    End With
End Sub

Pourriez-vous me dire ce que vous en pensez SVP ?

Merci d'avance.

 

[Paf]

Re : copier et insérer ligne suivant valeur

re,

Cells(i,12) fait référence à la feuille courante;pas de PB si la macro est lancé depuis la feuille Feuil1, sinon ...

Puisqu'on a déjà un With Worksheets("Feuil1") -End With qui englobe cette partie de code rajouter "." devant chaque Cells(... pour être référencé à Feuil1

sinon pas bien saisi l'histoire du prix :
si If Cells(i, 12).Value = Recherche est vrai, on diminue le prix existant de 150 et on inscrit 150 dans la ligne insérée ?

si c'est le cas, il y a sans doute moyen de faire un peu plus simple.

Si vous aviez d'autres questions, joignez un classeur sans données confidentielles.

A+

 

[KOGITUS]

Re : copier et insérer ligne suivant valeur

Bonjour Paf,

Voici un petit tableau en exemple.

Je suis curieux de voir votre solution plus simple.

Pour le prix, c'est ça.
Je connais le prix de départ, ex 200 euros. Je dois séparer certain frais du vrai prix donc je crée 2 lignes, une à 150 euros et l'autre à 50 euros.

Merci pour votre aide.

 

[Paf]

Re : copier et insérer ligne suivant valeur

Bonjour

rien de transcendant, la simplification porte sur le code et non sur la façon de calculer.

Sub CopieLigne()
    Dim Recherche As String, i As Long, Prix As Single
   
    Recherche = "A"
    With Worksheets("Feuil1")
    derlig = .Range("L" & Rows.Count).End(xlUp).Row
   
    For i = derlig To 2 Step -1 'Each cel In plage
        If .Cells(i, 12).Value = Recherche Then
            Prix = .Cells(i, 12).Offset(0, 2).Value - 150
            .Cells(i, 12).Offset(0, 2).Value = 150
            .Rows(i).Copy
            .Rows(i).Insert Shift:=xlDown
            Application.CutCopyMode = False
            .Cells(i, 12).Offset(0, 2).Value = Prix
            ' ou .Cells(i + 1, 12).Offset(0, 2).Value = Prix  'suivant ligne à 150 en premier
        End If
    Next i
    End With
End Sub

Bonne suite

 

[KOGITUS]

Re : copier et insérer ligne suivant valeur

Merci beaucoup Paf!

C'est parfait!

J'espère pouvoir mettre ça en application la semaine prochaine

Merci pour tout et bonne soirée!!