Incrémenter automatiquement lignes par rapport valeur cellule [Résolu]

[maximilien59]

Bonjour,

Je suis à la recherche d'un code en Vba qui me permettrai pour les valeurs de la colonne B (non vide) d'inserer le nombre de lignes complètent en dessous par rapport à la valeur de la colonne D qui est sur la meme ligne.

exemple:

de base:
en B2 : Tata en D2:5
en B3: titi en D3: 2
en B4: toto en D4: 3

Au finale:
en B2:Tata en D2:5
en B3:Tata
en B4:Tata
en B5:Tata
en B6:Tata
en B7: titi en D7: 2
en B8: titi
en B9: toto en D9: 3
en B10: toto
en B11: toto

Est-ce possible?

Je vous remercie

[jfontaine]

Bonjour,

oui, cela est faisable.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Insert_ligne()
 
Dim Ligne As Long   'Ligne en court
Dim i As Integer
 
Ligne = 2
'Boucle sur chaque ligne de la feuille
Do While Range("B" & Ligne).Value <> ""
   'Ajoute les lignes manquantes
    For i = 1 To Range("D" & Ligne).Value - 1
        Ligne = Ligne + 1
        Rows(Ligne).Insert
        Range("B" & Ligne).Value = Range("B" & Ligne - 1).Value
    Next i
Ligne = Ligne + 1
Loop
 
End Sub

[maximilien59]

Merci pour cette reponse rapide.

Et si je veux faire une modif en rajoutant par exemple 3 colonnes entre la 1er colonne et la colonne contenant la valeur et tout copier sauf le chiffre?

[jfontaine]

Si tu veux modifier la structure du fichier, fais le après le traitement des ajouts de lignes.

[maximilien59]

Merci pour cette reponse rapide.

Ce que je voudrai exactement (suite à une modif qu'on ma demandé) c'est plus

de base:
en B2 : Tata c2: AA ..... en G2:5
en B3: titi C3:BB ........ en G3: 2
en B4: toto C4 :CC ....... en D4: 3

Au finale:
en B2:Tata en c2:AA ........ en F2:1 en G2 :5
en B3:Tata en c3: AA ........en F3:2
en B4:Tata en c4: AA........ en F4:3
en B5:Tata en c5: AA........ en F5:4
en B6:Tata en c6: AA.........en F6:5
en B7: titi en c7: BB ........ en F7:1 en G7 :2
en B8: titi en c8 BB......... en F8:2
en B9: toto en c9:CC ........ en F9:1 en G9 :3
en B10: toto en c10:CC ........ en F10:1
en B11: totoen c11:CC ........ en F11:1


Pouvez vous m'aider? merci

[BlueMonkey]

Bonsoir,

Le boulot est fait par Jfontaine
Les adaptations pour la mise à jour de l'algo.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Insert_ligne()
    Dim Ligne As Long   'Ligne en court
    Dim i As Integer
     
    Ligne = 2
    'Boucle sur chaque ligne de la feuille
    Do While Range("B" & Ligne).Value <> ""
       Range("F" & Ligne).Value = 1
       'Ajoute les lignes manquantes
        For i = 1 To Range("G" & Ligne).Value - 1
            Ligne = Ligne + 1
            Rows(Ligne).Insert
            Range("B" & Ligne).Value = Range("B" & Ligne - 1).Value
            Range("C" & Ligne).Value = Range("C" & Ligne - 1).Value
            Range("F" & Ligne).Value = i + 1
        Next i
    Ligne = Ligne + 1
    Loop
End Sub

Rmq: Cet algo génèrera sur l'exemple précédent F10:2 ; F11:3 (et non pas F10:1 ; F11:1 comme demandé précédemment)

[maximilien59]

Merci pour cette aide précieuse.