Insérer une ligne à chaque changement de valeur [Fermé]

Signaler
Messages postés
12
Date d'inscription
samedi 6 juillet 2019
Statut
Membre
Dernière intervention
16 septembre 2019
-
 gyrus -
bonjour
je suit débutent en vba .
je cherche une code VBA qui me permette d' insérer 2 lignes à chaque changement de valeur de la cellule colonne A et copier la formule exemple et la 1er cellule :

//////////////////////////////////////////////////////////////
/ / A / B / C / D /
/////////////////////////////////////////////////////////////
/ 1/PH1 /=C1+D1 / 5 / 6 /
////////////////////////////////////////////////////////////
/2/PH2 /=C2+D2 / 8 / 7 /
///////////////////////////////////////////////////////////




//////////////////////////////////////////////////////////////
/ /...A...../....B......./ C..../....D.... /
/////////////////////////////////////////////////////////////
/ 1/PH1 /=C1+D1 /.... 5 ... / 6 /
////////////////////////////////////////////////////////////
/2/PH1 /=C2+D2 /............/.............../
///////////////////////////////////////////////////////////
/3/PH1 /=C3+D3 /............/.............../
///////////////////////////////////////////////////////////
/4/PH2 /=C4+D4 / 8 / 7 /
///////////////////////////////////////////////////////////

2 réponses

Messages postés
1941
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
23 août 2020
138
Bonjour,

Si PH1 est forcément différent de PH2 :
Sub Insertion(l As Integer)
    Cells(l + 1, 1).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(l + 1, 1).Value = Cells(l, 1).Value
    Cells(l + 2, 1).Value = Cells(l, 1).Value
End Sub

Sub a()
    Der = Range("A65536").End(xlUp).Row
    For l = Der To 1 Step -1
        Insertion (l)
    Next l
    DerN = Range("A65536").End(xlUp).Row
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B" & DerN), Type:=xlFillDefault
End Sub
Messages postés
12
Date d'inscription
samedi 6 juillet 2019
Statut
Membre
Dernière intervention
16 septembre 2019

merci zoul67
il faut copier juste le formule et le 1er cellule de line i :( et aussi inséré les ligne a chaque changement de la contenu de 1er celulle
Bonjour,

Essaie avec
Sub Test()
Dim Ligne As Long
For Ligne = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("A" & Ligne - 1).Value <> Range("A" & Ligne).Value Then
Rows(Ligne).Resize(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(Ligne - 1, 1).Resize(, 2).Copy Cells(Ligne, 1).Resize(2, 2)
End If
Next Ligne
End Sub

Cordialement.
Messages postés
12
Date d'inscription
samedi 6 juillet 2019
Statut
Membre
Dernière intervention
16 septembre 2019

bonjour gyrus
merci pour vous mai ca marche pas
Bonjour

De mon côté, pas de souci. Il faut croire que tes explications n’ont pas suffi.
Voici mon fichier test.
https://www.cjoint.com/c/IIhh0YHaeWj

Pour avancer, il est souhaitable que tu mettes à disposition un fichier sans données confidentielles, en donnant toutes les explications utiles et en précisant clairement le résultat attendu.
Pour cela tu peux créer un lien de partage sur l'un de ces sites :
https://www.cjoint.com/
https://mon-partage.fr/

Cordialement