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

Vincent31140 · 6 Janvier 2021

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 · 7 Janvier 2021

Alors ceci

VB:

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

Rouge · 7 Janvier 2021

Bonjour,

Ceci:

VB:

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 · 7 Janvier 2021

Rouge à dit:

Bonjour,

Ceci:

VB:

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 · 7 Janvier 2021

Alors ceci

VB:

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 · 7 Janvier 2021

Rouge à dit:

Alors ceci

VB:

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

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

Vincent31140

XLDnaute Nouveau

Rouge

Rouge

XLDnaute Impliqué

Vincent31140

XLDnaute Nouveau

Rouge

XLDnaute Impliqué

Vincent31140

XLDnaute Nouveau

Discussions similaires