Ajout de ligne automatiquement

Bonjour, je cherche à faire des étiquettes publipostage en faisant des saut de page en fonction d'un certain nom dans un "champs" mais je n'y arrive pas.

je voudrais donc sur mon fichier excel ajouter des lignes automatiquement en fonction du mot en colonne B pour que cela fasse mon saut de page automatiquement dans le publipostage.

il faudrait que le mot "TUBE PENDERIE ROND" & "ETAGERE" sois tout seul et que tout le reste sois regroupés normalement sur les pages étiquettes.

il y a 16 étiquettes par feuille.

Ex : si il y a 9 "TUBE PENDERIE ROND" : ajouter 7 lignes vide en dessous pour faire une page. Si il y a en a 18 : ajouter 14 ligne vide en dessous (16 sur la 1ere feuille étiquette, et 2 sur la 2ème feuille)

et c'est le même principes pour le mot "ETAGERE". (il faudrait donc ajouter des ligne au dessus du mot aussi pour que cela commence bien sur une nouvelle feuille).

le fichier est toujours trié comme cela de Z à A dans la colonne B. et il peux ne pas y avoir de tube ou étagère dans certain fichier.

L'idéale serait d'imposer ces 2 mot dans le code pour pouvoir les modifier au cas ou il faudrait changer.

Est-ce que quelqu'un pourrait m'aider à faire cela, je ne vois pas du tout comment faire.., merci par avance.

Bonjour,

Pas sûr que j'arrive à maintenir ce code main en tout cas il permet d'arriver au résultat attendu :

Sub PUBLI_2()
Dim ART() As Variant, LR%, L%, INC%, I%, L_INSERT%
ART = Array("TUBE PENDERIE ROND", "ETAGERE")
With ActiveSheet
LR = .Cells(.Rows.Count, 2).End(xlUp).Row 'Def dernière ligne
    For L = LR To 2 Step -1 'Pour chaque ligne
        INC = INC + 1 'Incrémente e 1
        If .Cells(L, 2).Offset(-1) <> .Cells(L, 2) Then 'Si les cellules L et L-1 différente
            For I = LBound(ART) To UBound(ART)
                If .Cells(L, 2) = ART(I) Or .Cells(L, 2).Offset(-1) = ART(I) Then 'Si cellule L et L-1 dans critères recherchés
                    If L_INSERT > 0 Then .Cells(L_INSERT, 2).Resize(16 - INC, 1).EntireRow.Insert xlUp 'Si ligne d'insertion >0 alors insère lignes égal à 16 - incrémentation 
                    L_INSERT = L 'Défini nouvelle ligne insertion
                    INC = 0 'RaZ l'incrémentation pour nouvelle plage
                End If
            Next I
        End If
    Next L
End With
End Sub

Cdlt,

bonjour Ergotamine, merci d'avoir pris de votre temps pour mon problème.

Le code fonctionne parfaitement pour l'exemple, mais si je rajoute des "TUBE" pour qu'il y en est plus de 16, ou bien plus de "SEPARATION" par exemple pour dépasser 16 également, le code ce met en erreur. le fichier fourni est une petite commande j'en est avec des quantités beaucoup plus grosse avec 5x ou 10x plus de pièce mais toujours sur le même principe.

Bonjour,

Pour les prochaines fois, donnez un maximum de conditions pour que le code soit adapter au plus proche du besoin. Cependant votre fichier fourni avec résultat avant VS après était très bien pour comprendre la problématique, il faut le souligner. Donc merci ! Ci contre le code corrigé :

Sub PUBLI_2()
Dim ART() As Variant, LR%, L%, INC%, I%, L_INSERT%
ART = Array("TUBE PENDERIE ROND", "ETAGERE")
With ActiveSheet
LR = .Cells(.Rows.Count, 2).End(xlUp).Row 'Def dernière ligne
    For L = LR To 2 Step -1 'Pour chaque ligne
        INC = INC + 1 'Incrémente e 1
        If INC = 16 Then INC = 0
        If .Cells(L, 2).Offset(-1) <> .Cells(L, 2) Then 'Si les cellules L et L-1 différente
            For I = LBound(ART) To UBound(ART)
                If .Cells(L, 2) = ART(I) Or .Cells(L, 2).Offset(-1) = ART(I) Then 'Si cellule L et L-1 dans critères recherchés
                    If L_INSERT > 0 Then .Cells(L_INSERT, 2).Resize(16 - INC, 1).EntireRow.Insert xlUp 'Si ligne d'insertion >0 alors insère lignes égal à 16 - incrémentation
                    L_INSERT = L 'Défini nouvelle ligne insertion
                    INC = 0 'RaZ l'incrémentation pour nouvelle plage
                End If
            Next I
        End If
    Next L
End With
End Sub

Ca devrait mieux correspondre, si ce n'est toujours pas le cas, merci de renouveler votre fichier 1 avec un exemple représentatif.

Cdlt,

Je viens de faire plusieurs essai sur différentes commandes et tout marche à merveille. Merci encore Ergotamine