insérer une ligne à chaque changement de valeur

Question

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     /
///////////////////////////////////////////////////////////

Zoul67 · Answer

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

gyrus · Answer

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 LigneEnd Sub
Cordialement.

Insérer une ligne à chaque changement de valeur

2 réponses

Discussions similaires

Newsletters