Insérer une ligne à chaque changement de valeur

Messages postés
12
Date d'inscription
samedi 6 juillet 2019
Statut
Membre
Dernière intervention
16 septembre 2019
- - Dernière réponse :  gyrus - 7 sept. 2019 à 09:55
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 /
///////////////////////////////////////////////////////////
Afficher la suite 

2 réponses

Messages postés
1928
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
17 septembre 2019
122
0
Merci
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
zai_1989
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
Commenter la réponse de Zoul67
0
Merci
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.
zai_1989
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
Commenter la réponse de gyrus