XL 2013 VBA - Insérer Lignes selon Critère en boucle

[Vincent31140]

Bonjour,
Je suis tout nouveau dans ce monde de programmation VBA et utilise pour la première fois un forum pour m'aider !
J'espère que vous m'aiderez...

J'ai créer ce code qui permet d'insérer une ligne en dessous d'une ligne où se trouve le mot PAPA en colonne B.

Sub Copier_Coller_Modifier_Lignes()
'Inserér Lignes

Worksheets("FAMILLE").Activate

Dim Status As Range, Plage As Range
Dim DerLigne As Long, Ligne As Long

Application.ScreenUpdating = False

DerLigne = Cells(65536, 1).End(xlUp).Row
Set Plage = Range(Cells(1, 2), Cells(DerLigne, 2))

For Each Status In Plage
If StatusPN = "PAPA" Then
Cells(Status.Row + 1, 1).EntireRow.Insert Shift:=xlDown
End If

Next Status
End Sub

Ce code fonctionne.

Maintenant, je souhaite compliquer les choses.
J'aimerais copier la ligne entière où se trouve le mot PAPA en colonne B et l'insérer juste en dessous de celle-ci.
Et en plus, modifier le contenu de cette nouvelle ligne en colonne B, en modifiant PAPA par Fils.

Pouvez-vous m'aider s'il vous plait !
Merci pour votre aide

 

[Rouge]

Bonjour,

Ceci:

Sub Copier_Coller_Modifier_Lignes()
    Dim Status As Range, Plage As Range
    Dim DerLigne As Long, Ligne As Long    
    Application.ScreenUpdating = False
    Worksheets("FAMILLE").Activate    
    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    Set Plage = Range(Cells(1, 2), Cells(DerLigne, 2))    
    For Each Status In Plage
        If Status = "PAPA" Then
            Cells(Status.Row + 1, 1).EntireRow.Insert Shift:=xlDown
            Cells(Status.Row + 1, 2) = "Fils"
        End If
    Next Status
End Sub

Cdlt

 

[Vincent31140]

Bonjour,

Ceci:

Sub Copier_Coller_Modifier_Lignes()
    Dim Status As Range, Plage As Range
    Dim DerLigne As Long, Ligne As Long   
    Application.ScreenUpdating = False
    Worksheets("FAMILLE").Activate   
    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    Set Plage = Range(Cells(1, 2), Cells(DerLigne, 2))   
    For Each Status In Plage
        If Status = "PAPA" Then
            Cells(Status.Row + 1, 1).EntireRow.Insert Shift:=xlDown
            Cells(Status.Row + 1, 2) = "Fils"
        End If
    Next Status
End Sub

Cdlt

Bonjour Rouge,
Je te remercie pour ton aide et l'insertion du mot Fils apparait en colonne B de chaque ligne insérée.

Par contre, ce n'est pas exactement ce que je souhaitais.
Au lieu, d'insérer une ligne vide, je souhaite copier la ligne où se trouve le mot PAPA, et l'insérer en dessous.
C'est ensuite, qu'il faut modifier le mot PAPA de cette nouvelle ligne par Fils

Merci encore.

 

[Rouge]

Alors ceci

Sub Copier_Coller_Modifier_Lignes()
    Dim Status As Range, Plage As Range
    Dim DerLigne As Long, Ligne As Long
    Application.ScreenUpdating = False
    Worksheets("FAMILLE").Activate
    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    Set Plage = Range(Cells(1, 2), Cells(DerLigne, 2))
    For Each Status In Plage
        If Status = "PAPA" Then
            Rows(Status.Row).Copy
            Rows(Status.Row + 1).Insert Shift:=xlDown
            Cells(Status.Row + 1, 2) = "Fils"
        End If
    Next Status
End Sub

 

[Vincent31140]

Alors ceci

Sub Copier_Coller_Modifier_Lignes()
    Dim Status As Range, Plage As Range
    Dim DerLigne As Long, Ligne As Long
    Application.ScreenUpdating = False
    Worksheets("FAMILLE").Activate
    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    Set Plage = Range(Cells(1, 2), Cells(DerLigne, 2))
    For Each Status In Plage
        If Status = "PAPA" Then
            Rows(Status.Row).Copy
            Rows(Status.Row + 1).Insert Shift:=xlDown
            Cells(Status.Row + 1, 2) = "Fils"
        End If
    Next Status
End Sub

Merci Rouge tu es un magicien
Compliqué de démarrer sur VBA, vivement que je gagne en compétences§
Bonne journée à toi