Dupliquer des lignes selon la valeur indiquée dans une cellule

Bonjour à tous,

J'ai besoin d'un petit coup de main sur une macro qui me pose problème :

Je travaille sur le fichier joint, et je souhaite lorsque la colonne M comporte une valeur supérieure à 1 dupliquer la ligne le nombre de fois correspondant.

Par exemple : dans la ligne 3, la valeur de la cellule M3 est 3, je souhaite donc que la ligne apparaisse 3 fois à la suite, et si possible en remplaçant dans chacune des 3 lignes la valeur 3 par la valeur 1. Mais pour cette dernière partie, j'ai trouvé une autre solution (mais qui n'est surement pas la meilleure).

J'ai trouvé des sujets qui traitaient d'un problème similaire, mais lorsque j'applique cette macro (trouvée dans un sujet de 2015), les dernières lignes se dupliquent un grand nombre de fois, même lorsque la valeur de la colonne M est 1 :

Sub Dupliquer()

Dim n&, i&

With ActiveSheet

n = .Range("M" & .Rows.Count).End(xlUp).Row

For i = n To 2 Step -1

If .Cells(i, 1).Value > 1 Then

.Range(Cells(i, 1), Cells(i, 13)).Copy

.Range(Cells(i + 1, 1), Cells(i + .Cells(i, 1).Value - 1, 13)).Rows.Insert xlShiftDown

End If

Next i

End With

Application.CutCopyMode = False

End Sub

J'espère avoir été claire dans ma demande, merci d'avance !

Bonjour StéphaniePRTS et bienvenue,

Il y avait une méchante erreur dans ton code:

.Range(Cells(i + 1, 1), Cells(i + .Cells(i, 1).Value - 1, 13)).Rows.Insert xlShiftDown

Le test ">1" doit aussi se faire sur la colonne 13 (M)

Si ton tableau ne contient pas un trop grand nombre de lignes, essaie avec

Sub Dupliquer()
Dim n&, i&
With Feuil1
n = .Range("M" & .Rows.Count).End(xlUp).Row
For i = n To 2 Step -1
If .Cells(i, 13).Value > 1 Then
.Range(Cells(i, 1), Cells(i, 13)).Copy
.Cells(i + 1, 1).Resize(.Cells(i, 13).Value - 1, 13).Rows.Insert xlShiftDown
.Cells(i, 13).Resize(.Cells(i, 13).Value, 1).Value = 1
End If
Next i
End With
Application.CutCopyMode = False
End Sub

Merci U.Milité de cette réponse rapide.

Je veux bien croire qu'il y ait eu une méchante erreur, ne comprenant pas la totalité du code, je l'avais adapté, mais pas en totalité à priori ...

J'ai testé sur mon fichier réel, qui fait 396 lignes, mais peut être amené à en faire plus (il s'agit de factures de remboursement de transports) selon la période sur laquelle je travaille.

J'obtiens le message d'erreur suivant :

"Erreur d'execution '1004':

La méthode 'Range' de l'objet '_Worksheet' a échoué"

Et dans le volet VBA, la ligne suivante est surlignée en jaune :

.Range(Cells(i, 1), Cells(i, 13)).Copy

Par contre mon onglet s'appel "total_activite", il faut donc surement que je mette ça à la place de "feuil1" dans la boucle, non ?

Je comprend les macros quand je les fait à partir d'un enregistrement, mais j'avoue que la ça devient un peu complexe pour moi ...

Merci.

Re-bonjour,

StéphaniePRTS a écrit :

Par contre mon onglet s'appel "total_activite", il faut donc surement que je mette ça à la place de "feuil1" dans la boucle, non ?

With Sheets("total_activite")

Quant à l'erreur que tu obtiens, difficile de dire d'où elle peut provenir ... dans la mesure où on ne sait pas comment est structuré ton fichier "réel", ni où tu as placé le code !?

Essaie de coller le code dans un module standard et de faire précéder les 2 "Cells" dans la ligne incriminée d'un '.'

.Range(.Cells(i, 1), .Cells(i, 13)).Copy

Bonjour,

Ca marche parfaitement avec cette modification, merci beaucoup !

Mon fichier réel est identique à celui que j'avais mis en exemple, mais avec de vrais informations, mon code se trouve dans un module au milieu d'autres macros qui fonctionnent très bien !

Merci de ton aide !

Bonjour à tous,

Recherchant à résoudre le même problème que Stéphanie, j'ai donc essayé le module VBA modifié U. milité :

Sub Dupliquer()

Dim n&, i&

With book1

n = .Range("E" & .Rows.Count.End(xlUp).Row)

For i = n To 2 Step -1

If .Cells(i, 13).Value > 1 Then

.Range(.Cells(i, 1), .Cells(i, 13)).Copy

.Cells(i + 1, 1).Resize(.Cells(i, 13).Value - 1, 13).Rows.Insert xlShiftDown

.Cells(i, 13).Resize(.Cells(i, 13).Value, 1).Value = 1

End If

Next i

End With

Application.CutCopyMode = False

End Sub

Cependant cela ne marche pas pour mes données (ci jointes) ...

Et dans le volet VBA, la ligne suivante est surlignée en jaune :

n = .Range("E" & .Rows.Count.End(xlUp).Row)

Le nombre de ligne à dupliquer étant dans cette colonne E...

Quelqu'un a t il une petite idée de solution?

Merci d'avance et bonne journée

Bonjour Antinea et

Essayer, c'est bien ... mais il vaut mieux essayer de comprendre d'abord

La première question est: "est-il nécessaire de passer par une macro, si tu ne maîtrises pas le langage VBA ?"

Que cherches-tu à faire, précisément ?

.

With book1

book1 est le nom de ton classeur ... c'est le nom de la feuille concernée qu'il faut indiquer

n = .Range("E" & .Rows.Count.End(xlUp).Row)

il y a une parenthèse qui a dû déraper sur le verglas et qui n'est plus du tout à sa place

If .Cells(i, 13).Value > 1 Then

il n'y a absolument rien dans la 13^e colonne de ta feuille !? Peu de chances donc d'y trouver une valeur qui soit supérieure à 1

... je me suis arrêté là, en attendant que tu nous en dises plus

Bonjour U milité,

Merci tout d'abord pour cette réponse rapide

Ce que je cherche à faire c'est dupliquer les lignes le nombre de fois indiqué dans la colonne E.

C'est à dire que lorsque la colonne E a une valeur >1, je puisse dupliquer la ligne entière le nombre de fois correspondant.

Et, dans l’idéal, que la valeur indiqué dans la colonne E soit modifié en 1 ! (Mais ça c'est en plus!!)

Bref, un peu beaucoup comme Stéphanie!

Ci joint le tableau final (du tableau book1 précédent) que j'aimerai obtenir avec une formule/macro/ou autre !

Je ne maitrise pas le language VBA, bingo! Je viens de le découvrir grâce à votre forum,

Es ce vraiment inaccessible à des novices?

En tout cas, j'ai modifié ce que tu m'avais dis :

book1 est le nom de ton classeur ... c'est le nom de la feuille concernée qu'il faut indiquer ok!

il y a une parenthèse qui a dû déraper sur le verglas yep, trouvé !

il n'y a absolument rien dans la 13e colonne de ta feuille !? oui je croyais que ça valait : inférieur à 1 --> il faut donc aucune case vide dans le fichier...

cela donne :

Sub Dupliquer()

Dim n&, i&

With Sheet1

n = .Range("E" & .Rows.Count).End(xlUp).Row

For i = n To 2 Step -1

If .Cells(i, 5).Value > 1 Then

.Range(.Cells(i, 1), .Cells(i, 5)).Copy

.Cells(i + 1, 1).Resize(.Cells(i, 5).Value - 1, 5).Rows.Insert xlShiftDown

.Cells(i, 5).Resize(.Cells(i, 5).Value, 1).Value = 1

End If

Next i

End With

Application.CutCopyMode = False

End Sub

Mais cela ne marche toujours pas...

En tout cas, merci encore,

Et si tu as la patience, à bientôt!

Bonjour,

Salut U.Milité

Ci-joint ton fichier test corrigé ...

avec quelques explications qu' U.Milité t'a déjà données ...

Re-bonjour,

Le code tel que tu l'as modifié est fonctionnel chez moi et donne le résultat que je crois que tu attends ... à condition de ne pas l'exécuter sur ton dernier fichier (puisqu'en colonne E, aucune valeur n'est supérieure à 1).

Sur ton fichier initial, ça donne le même résultat que l'exemple de résultat attendu

[Edit:] Oupsss Salut James

Salut U.Milité

Tu as raison ... !!!

Mais le code posté sur le Forum n'est pas le code placé dans le Module ... du coup ... petit problème

Et, comme tu le dis ... lancer la duplication lorsqu' une instruction est en place pour exclure les valeurs égales à 1 ... cela ne va pas faciliter la chose ...

Juste un petit message pour vous dire MERCI !

je vous embête plus, ça maaaaaarche !

Je vais le tester sur mon gros fichier (merci James pour l'explication du j, ça va être utile aussi !)

Bonne continuation à tous

De rien ...

Content que cela puisse t'aider ...