Insérer n lignes à partir de la valeur lue dans une cellule

[Rické]

Bonjour,

J'ai quelques notions en VBA mais là c'est plus fort que moi, j'ai besoin de votre aide pour m'en sortir.

Voilà l'objectif.

J'ai en face de moi un tableau avec les champs en colonnes et les données en lignes. Une colonne s'appelle "nombre" (colonne I).
Je souhaite éclater chaque ligne en autant de lignes que la valeur lue dans la cellule de la colonne "nombre". (Donc si la valeur est inférieure ou égale à 1, il n'y a pas création de nouvelle ligne)
L'insertion des nouvelles lignes devant se faire sous la ligne de référence.
Les données des nouvelles lignes doivent être les mêmes sauf dans la colonne nombre ou la valeur doit être maintenant 1.

J'espère avoir été clair, que vous pourrez me dépanner.

Merci
Salutations,
Rické

 

[jpb388]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Bonsoir
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Compteur As Integer
Dim LeChiffre As Integer
Dim I As Integer
Compteur = 2
Do
LeChiffre = Cells(Compteur, 1).Value
Cells(Compteur, 1).Select
Cells(Compteur, 1).Formula = 1
If LeChiffre > 1 Then
For I = 1 To LeChiffre
Rows(Compteur + I & ":" & Compteur + I).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next
For I = 1 To LeChiffre
Rows(Compteur & ":" & Compteur).Select
Selection.Copy
Range("a" & Compteur + I).Select
ActiveSheet.Paste
Next
End If
Compteur = Compteur + 1
Loop Until Cells(Compteur, 1).Value = ""
End Sub
à+
jpb

 

[kjin]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Bonsoir et bienvenue,
[thread=32841]charte-du-forum-lire-avant-de-poster[/thread]
J'ai considéré les colonnes A à J et ne sachant pas la nature des données

Sub aAdapter()
Application.ScreenUpdating = False
With ActiveSheet
    For i = .Range("I65000").End(xlUp).Row To 1 Step -1
        If .Cells(i, 9) > 1 Then
        Set rng = .Range(.Cells(i, 1), .Cells(i, 10))
            For j = 1 To .Cells(i, 9)
                rng.Copy
                rng.Offset(1, 0).Insert Shift:=xlDown
            Next
        End If
    Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[Rické]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Merci pour vos réponses.
Je préciserai mes questions avec la charte à l'avenir.

 

[kjin]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Bonjour,
Il est sûr qu'un fichier exemple est toujours bienvenu
Pour jpb388, il est préférable de partir de la dernière ligne pour supprimer ou insérer des lignes, à moins d'en tenir compte dans la boucle (que fais tu des lignes que tu insères au fur et à mesure ?!)
En outre, je ne suis pas sûr qu'une macro événementielle de ce type (sélection de cellules) soit des plus recommandée, d'autant que pour corser le tout tu sélectionnes des cellules dans la macro même, ce qui est d'autant plus inutile !
Pour répondre à ton MP, regarde dans l'aide VBA l'utilisation de l'instruction With...End With
A+
kjin

 

[Rické]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Je viens de l'adapter à mon tableau. Ça fonctionne! Merci beaucoup pour le coup de main.

 

[Rické]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Bonjour,

Je reviens vers vous. En utilisant la macro de Kjin, il se produit une "erreur d'exécution 13, incompatibilité de type" à la ligne :
For j = 1 To .Cells(I, 9) - 1

Malgré ça la macro fonctionne bien. Cependant j'aurai voulu rajouter un bout de code derrière et cette erreur m'en empêche. Comment la faire disparaître?

En cherchant un peu, la macro parcourt les valeurs de la colonne I en partant du bas du tableau. La macro s'arrête quand on arrive à la dernière valeur supérieure à 1.

Voilà mon code :
Sub aAdapter()
Application.ScreenUpdating = False
Range("G:G,D😀,I:I").Select
Selection.NumberFormat = "0.00"
With ActiveSheet
For I = .Range("I65000").End(xlUp).Row To 1 Step -1
If .Cells(I, 9) > 1 Then
Set rng = .Range(.Cells(I, 1), .Cells(I, 11))
For j = 1 To .Cells(I, 9) - 1
rng.Copy
rng.Offset(1, 0).Insert Shift:=xlDown
Next
End If
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[jeanpierre]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Bonjour Rické, kjin, jpb,

A la lecture de ton code, peut-être en modifiant ici :

For I = .Range("I65000").End(xlUp).Row To 2 Step -1

sinon : For j = 1 To .Cells(I, 9) - 1 donne, pour I=1, Cells(0, 9) ce qui n'est pas possible.

Bonne journée.

Jean-Pierre

 

[Rické]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Il fallait bien modifier le 1 par un 2 dans cette ligne :
For I = .Range("I65000").End(xlUp).Row To 2 Step -1

J'ai pas vraiment compris pourquoi mais ça fonctionne du tonnerre.
Super forum.
Merci beaucoup

 

[jeanpierre]

Re : Insérer n lignes à partir de la valeur lue dans une cellule

Re,

Tant mieux, mais l'explication à : "J'ai pas vraiment compris pourquoi" est donné dans ma réponse avec :

sinon : For j = 1 To .Cells(I, 9) - 1 donne, pour I=1, Cells(0, 9) ce qui n'est pas possible.

Jean-Pierre