Insertion nombre de ligne variable en fonction d'une cellule

Bonjour à tous.

Dans le cadre de mon travail, je suis amené a travaillé pas mal de fichier excel pour ensuite en faire du publipostage pour impression d'etiquettes et j'essaie au maximum d'automatiser les modifications a faire sur le fichier excel.

J'ai eu beau chercher sur les differents forums, je n'ai malheureusement pas réussi a trouver une solution adaptée a mon probleme

j'ai un fichier adresse classique, nom / prenom / adr1 / adr2 / cp / ville / nbre exemplaire

mon champ nbre exemplaire est variable et je souhaiterais qu'avec une Macro, automatiquement j'ai une ligne ou plusieurs qui se créent quand mon nbres d'exemplaires est > 15 en coupant par tranche de 15

si 25ex, j'aurais alors 2 lignes avec les meme champs nom / prenom / etc par contre j'aurai une ligne a 15 ex et un ligne a 10 ex

si 45ex, j'aurais alors 3 lignes avec les meme champs nom / prenom / etc par contre j'aurai une ligne a 15 ex et un ligne a 15 ex et une derniere a 15ex

le but étant qu'automatiquement soient insérés le bon nombre de ligne a chaque nouvelle valeur trouvée.

je ne sais pas si c'est compréhensible.

pensez vous que quelque chose dans se sens est possible ?

Merci beaucoup pour vos propositions.

Arnaud

Bonjour,

Bien sûr ! Mais il faudrait que tu fournisses un modèle, et confirmes que tu fais la modification dans la cellule concernée.

Et également si tu envisages de faire la modification inverse en supprimant manuellement les lignes qui deviendraient de trop...

Cordialement.

Bonjour et merci pour votre réponse,

j'etais justement en train de préparer un fichier, ne pouvant me permettre de mettre l'original (cela concerne le ministere de la defense... )

dans le fichier j'ai fait 2 feuilles, une avant, et une avec le résultat souhaité.

pas de modification dans l'autre sens

en plus je pourrais adapter la formule a d'autres documents, car je coupe souvent mes fichiers a 15ex

Merci

Voilà !

Sub InsertionsLignes()
    Dim nbEx%, nbL%, n%, i%, j%
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        With .Range("A" & n + 1).Resize(, 11).Borders
            .LineStyle = xlContinuous: Weight = xlThin
        End With
        For i = n To 2 Step -1
            nbEx = .Cells(i, 11)
            nbL = Int((nbEx - 1) / 15) + 1
            If nbL > 1 Then
                .Range("A" & i + 1 & ":K" & i + nbL - 1).Insert xlShiftDown
                .Range("A" & i).Resize(, 11).Copy .Range("A" & i & ":A" & i + nbL - 1)
                For j = 1 To nbL
                    .Range("K" & i + j - 1) = IIf(nbEx > 15, 15, nbEx)
                    nbEx = nbEx - 15
                Next j
            End If
        Next i
        n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Rows(n).Delete
    End With
End Sub

Cordialement.

Franchement, ca marche super bien, c'est vraiment top

j'ai juste une derniere condition que j'ai oublié de mentioné, c'est que a partir de la quantité 125 ex on ne coupe plus par paquet de 15 on laisse la quantité tel quel, c'est jouable ?

Merci beaucoup en tout cas

Ajouter lignes surlignées :

...
        For i = n To 2 Step -1
            nbEx = .Cells(i, 11)
            If nbEx < 125 Then
                nbL = Int((nbEx - 1) / 15) + 1
                If nbL > 1 Then
                    .Range("A" & i + 1 & ":K" & i + nbL - 1).Insert xlShiftDown
                    .Range("A" & i).Resize(, 11).Copy .Range("A" & i & ":A" & i + nbL - 1)
                    For j = 1 To nbL
                        .Range("K" & i + j - 1) = IIf(nbEx > 15, 15, nbEx)
                        nbEx = nbEx - 15
                    Next j
                End If
            End If
        Next i
...

Super, c'est exactement ca qu'il me fallait

Désolé de n'avoir pu te répondre avant (en pleine préparation pour les elections legislatives et c'est dur dur)

J'ai essayé de comprendre ton code pour l'adapter a un autre fichier qui est similaire dans le principe, mais different dans le découpage des colonnes et de la quantités, et apres plusieurs test, je n'ai rien réussi a faire XD

Tu pourrais m'expliquer un peu la structure, comment est composé ton code ?

je voudrais bien essayé de l'adapter pour essayer de le faire moi meme par la suite, et ne pas demander de l'aide a chaque fois

En tout cas, merci beaucoup, tu m'as fais gagner enormement de temps

Bonsoir,

Commentaire de la partie centrale : boucle de parcours des lignes en remontant de la dernière vers la ligne 2.

On le fait en remontant car l'insertion de lignes modifie l'emplacement des lignes suivantes...

On récupère d'abord le nombre d'exemplaires en col. K (nbEx).

A partir de 125, pas d'insertion, donc on opère sous condition que nbEx soit <125.

On calcule le nombre de lignes correspondant au nombre d'exemplaires (on prend la partie entière du quotient du nb d'ex. -1 par 15 et on ajoute 1 [-1 pour pouvoir ajouter 1 à coup sûr]).

Si le nb de lignes trouvé (nbL) est supérieur à 1, il faut insérer les lignes manquantes au-dessous de la ligne testée, soit nbL-1 lignes.

On procède donc à l'insertion : méthode Insert appliquée à une plage de A à K comportant nbL-1 lignes à partir de la ligne suivant la ligne testée.

(NB- On pouvait ne pas ajouter 1 lors du calcul de nbL, on calculait alors seulement le nb de lignes à insérer, on faisait le test sur 0 au lieu de 1, et on ne retranchait pas pour l'insertion, quel que soit le choix faut pas se mélanger en cours de route...)

On copie la ligne initiale pour la coller sur les lignes insérées.

On utilise une boucle pour parcourir les lignes du groupe ligne initiale + lignes insérées afin de modifier le nombre d'exemplaires en K. On utilise nbEx recueilli au départ de l'examen de la ligne : si nbEx est supérieur à 15 on met 15, sinon la valeur de nbEx, en désincrémentant nbEx de 15 à chaque tour.

Voilà pour le traitement proprement dit, le reste de la macro qui encadre cette boucle :

Sub InsertionsLignes()
    Dim nbEx%, nbL%, n%, i%, j%
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        With .Range("A" & n + 1).Resize(, 11).Borders
            .LineStyle = xlContinuous: Weight = xlThin
        End With

...

        n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Rows(n).Delete
    End With
End Sub

Au départ, on récupère le numéro de la dernière ligne. On applique également les bordures de mise en forme du tableau à la ligne qui suit cette dernière ligne...

Lorsqu'on insère des lignes, les cellules insérées prennent par défaut le format de la ligne qui précède (on peut ajouter un argument pour que ce soit le format de la ligne qui suit qui soit pris, mais ici le format par défaut convenait très bien...). Seulement les bordures ne suivent en totalité que si la ligne à partir de laquelle on insère est également bordée. On ajoute donc ces bordures pour le cas où on ait à insérer sur la dernière ligne...

A la fin, le tableau s'est allongé, on recherche donc à nouveau la dernière ligne. La ligne qui suit est bordée mais restée vide, on la supprime donc...

Cordialement.

Merci beaucoup pour l'analyse,

c'est un peu complexe pour moi tout ça, il va falloir que je me penche dessus a tête reposée ...

En tout cas, merci beaucoup pour l'implication et le temps passé

cela va m’être d'une grande aide.

Arnaud

Bonjour a tous,

je rebondis sur ce poste pour demander une petite mise a jour

cela fonctionne parfaitement, j'ai juste modifié ma quantité maintenant a 8 et non plus a 15 comme demandé

Code actuellement utilisé:

Sub InsertionsLignes()

Dim nbEx%, nbL%, n%, i%, j%

With ActiveSheet

n = .Cells(.Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

With .Range("A" & n + 1).Resize(, 11).Borders

.LineStyle = xlContinuous: Weight = xlThin

End With

For i = n To 2 Step -1

nbEx = .Cells(i, 11)

If nbEx < 125 Then

nbL = Int((nbEx - 1) / 8) + 1

If nbL > 1 Then

.Range("A" & i + 1 & ":K" & i + nbL - 1).Insert xlShiftDown

.Range("A" & i).Resize(, 11).Copy .Range("A" & i & ":A" & i + nbL - 1)

For j = 1 To nbL

.Range("K" & i + j - 1) = IIf(nbEx > 8, 8, nbEx)

nbEx = nbEx - 8

Next j

End If

End If

Next i

n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

.Rows(n).Delete

End With

End Sub

mais j'ai encore une requête, quand j'ai 9 exemplaires, la macro me crée donc 2 lignes, une ligne a 8ex et une ligne a 1ex, or nous ne pouvons avoir de lignes a 1ex. Dans ce cas précis, il aurait fallu que la ligne 9ex soit scindée en une ligne a 7ex et une ligne a 2ex.

idem pour les lignes a 17ex et plus, avec la macro actuelle, la macro crée 2 lignes a 8ex et une ligne a 1ex, il faudrait donc que la macro me crée une ligne a 8ex une ligne a 7ex et une ligne a 2ex.

pensez vous que cela soit possible ?

Grand merci par avance a ceux qui pourront y jeter un oeil.

Arnaud