XL 2013 insérer lignes en automatique

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 !

RomainPOIRET

XLDnaute Occasionnel
Bonjour à tous,

Je bute sur une macro, j'aurais besoin de votre aide ...
Voici ce que je souhaite faire :

j'ai un tableau avec 2 colonnes ("lignes") et ("références"),
Je souhaiterai en fonction du contenu des cellules "lignes" ("macro fonctionnerait si cellules commencent par 1, 3, 4") insérer une ligne SI le contenu de la cellule d'à côté (colonne "référence") change (a partir du caractère suivant le nom de la ligne),

Je vous mets ci-joint le classeur,

En espérant être clair sur le sujet,

D'avance merci,

Romain
 

Pièces jointes

Solution
Bonjour,

Pour insérer des lignes par macro sur changement de valeur, il est plus pratique d'aller du bas vers le haut.
VB:
Sub InsLigne()
    Dim lg As Long
    Dim RefLigne As String, ref1 As String, ref2 As String
    With Sheets("Source")
        For lg = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
            ' Extraction de la refLigne
            RefLigne = .Cells(lg, 1)
            '
            ' Extraction en colonne 2 du premier mot après la refLigne
            ref1 = Split(Mid(.Cells(lg, 2), Len(RefLigne) + 2, Len(.Cells(lg, 2)) - Len(RefLigne)), " ")(0)
            '
            ' Idem sur la ligne inférieure
            ref2 = Split(Mid(.Cells(lg - 1, 2), Len(RefLigne) + 2, Len(.Cells(lg - 1, 2)) - Len(RefLigne)), "...
Oups pardon !
VB:
Sub InsLigne()
Dim L As Integer, Ligne As Integer
L = 1
Do While Cells(L, "B") <> ""

If Left(Cells(L, "A"), 1) = 1 And Left(Cells(L, "A"), 1) = 3 And Left(Cells(L, "A"), 1) = 3 Then
Else Left(Cells(L, "B"), 8)<> Left(Cells(L + 1, "B"), 8) Then
    Ligne = Cells(L + 1, "A").Row
    Rows(Ligne).Insert
    L = L + 1
End If

L = L + 1

Loop
End Sub

Voilà ! 🙂
 
Bonjour,

Pour insérer des lignes par macro sur changement de valeur, il est plus pratique d'aller du bas vers le haut.
VB:
Sub InsLigne()
    Dim lg As Long
    Dim RefLigne As String, ref1 As String, ref2 As String
    With Sheets("Source")
        For lg = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
            ' Extraction de la refLigne
            RefLigne = .Cells(lg, 1)
            '
            ' Extraction en colonne 2 du premier mot après la refLigne
            ref1 = Split(Mid(.Cells(lg, 2), Len(RefLigne) + 2, Len(.Cells(lg, 2)) - Len(RefLigne)), " ")(0)
            '
            ' Idem sur la ligne inférieure
            ref2 = Split(Mid(.Cells(lg - 1, 2), Len(RefLigne) + 2, Len(.Cells(lg - 1, 2)) - Len(RefLigne)), " ")(0)
            '
            ' Si le mot est différent alors ajouter une ligne au-dessus
            If ref2 <> ref1 Then .Cells(lg, 1).Resize(, 2).Insert xlShiftDown

        Next
    End With

End Sub
 

Pièces jointes

- 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

Réponses
6
Affichages
467
Retour