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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Vincent31140

XLDnaute Nouveau
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
 
Dernière édition:
Solution
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
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,

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.
 
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
649
Réponses
3
Affichages
451
Retour