XL 2013 insérer lignes en automatique

RomainPOIRET · 31 Janvier 2020

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

Hasco · 31 Janvier 2020

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)), "...

Hasco · 31 Janvier 2020

bonjour,

Je bute sur une macro

Ah bon ! Laquelle ? Aucune macro dans le fichier.

Cordialement

RomainPOIRET · 31 Janvier 2020

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à !

Hasco · 31 Janvier 2020

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

RomainPOIRET · 4 Février 2020

Super, merci Roblochon !

XL 2013 insérer lignes en automatique

RomainPOIRET

XLDnaute Occasionnel

Pièces jointes

Hasco

Hasco

XLDnaute Barbatruc

RomainPOIRET

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Pièces jointes

RomainPOIRET

XLDnaute Occasionnel

Discussions similaires