Insérer un ligne vierge et copier une valeur

[CmzxNéné]

Bonjour,

Pour mes besoins, j'aurais souhaité connaître une formule ou code pour insérer une ligne en dessous si une condition est remplie.
Je vous joins un fichier test avec des explications plus intuitives.
Merci de votre aide
Cdt

 

[tototiti2008]

Re : Insérer un ligne vierge et copier une valeur

Bonjour Néné,

à tester

Sub InsLig()
Dim i As Long, Valo
    For i = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & i).Value <> "" Then
            Valo = Range("B" & i).Value
            Range("B" & i + 1).EntireRow.Insert
            If Application.CountIf(Range("A2:A" & i), Valo) > 0 Then Range("A" & i + 1).Value = Valo
        End If
    Next i
End Sub

 

[pierrejean]

Re : Insérer un ligne vierge et copier une valeur

Bonjour CmzxNéné

Salut tototiti (verifie la ligne ou figure 90)

Ma version

 

[tototiti2008]

Re : Insérer un ligne vierge et copier une valeur

Bonjour PierreJean
Re,

en effet, je ne vérifiais l'existence que sur les lignes du dessus... bien vu

Sub InsLig()
Dim i As Long, Valo, NbLig as long
Nblig = Range("A" & Rows.Count).End(xlUp).Row
    For i = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & i).Value <> "" Then
            Valo = Range("B" & i).Value
            Range("B" & i + 1).EntireRow.Insert
            If Application.CountIf(Range("A2:A" & NbLig), Valo) > 0 Then Range("A" & i + 1).Value = Valo
        End If
    Next i
End Sub

 

[CmzxNéné]

Re : Insérer un ligne vierge et copier une valeur

Bonjour pierrejean et tototiti2008,

EXCELLENT !
Je vous remercie de votre post qui correspond à ce que j'attendais.
A tout moment
Cdt

Bonjour PierreJean
Re,

en effet, je ne vérifiais l'existence que sur les lignes du dessus... bien vu

Sub InsLig()
Dim i As Long, Valo, NbLig as long
Nblig = Range("A" & Rows.Count).End(xlUp).Row
    For i = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & i).Value <> "" Then
            Valo = Range("B" & i).Value
            Range("B" & i + 1).EntireRow.Insert
            If Application.CountIf(Range("A2:A" & NbLig), Valo) > 0 Then Range("A" & i + 1).Value = Valo
        End If
    Next i
End Sub