Insertion nombre variable de ligne - vba

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

J'ai besoin d'un coup de main VBA, je galère depuis des jours dessus. Je vous explique mon problème. Je gère une base donne de projets. Les projets sont gérés en 6 phases. Dans ma base de donne chaque projet contient donc 6 ligne pour chaque phase avec semaine de début et semaine de fin. Il arrive que l'on ait des interruptions de projets. J'aimerai, en fonction de la date d'interruption, insérer un nombre de ligne correspondant aux semaines d'interruption. Je vous joint un fichier pour illustrer mes propos.

Je m'explique, mon projet s'interrompt de la semaine 3 à 6, colonne B je trouve mon projet, colonne M je trouve ma ligne concernée en trouvant la semaine strictement supérieure à 3 et inferieure ou égale à 6. J'arrive à identifier ces éléments avec des couleurs mais impossible d'insérer le nombre de ligne voulu.

Les lignes insérées reprendraient les éléments d’information du projet mais au lieu du nom de la phase la mention = « Project interruption » ainsi que le numéro de la semaine dans la colonne M. Si le projet s’interrompt de la semaine 3 à 6, il faudrait 4 lignes avec leur numéro de semaine en colonne M.

Ligne 1 «Project interruption » 3
Ligne 2 «Project interruption » 4
Ligne 3 «Project interruption » 5
Ligne 4 «Project interruption » 6

J’espère que c’et assez claire pour que vous y apportez vos précieuse lumières !

Je vous joins le code entier:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 Sub interruption_projet() Dim premierecellule As Integer: Dim dernierecellule As Integer Dim semainedebut As Integer: Dim semainefin As Integer Dim Mon_projet As String Mon_projet = Range("T2").Value semainedebut = 3 semainefin = 6 nbdeligneainserer = 4 Dim bonnecolonne As Range Set bonnecolonne = Range("B2:B1000").Find(Mon_projet) I = bonnecolonne.Row Premiereligne = I derniereligne = I + 1 Do While Range("B" & derniereligne) = Mon_projet And Range("B" & Premiereligne) = Mon_projet And Range("B" & derniereligne) = Range("B" & Premiereligne) derniereligne = derniereligne + 1 Loop Range(Cells(Premiereligne, 1), Cells(derniereligne - 1, 17)).Select Selection.Interior.ColorIndex = 17 Dim Ma_plage As Range Dim Cell As Range Dim macell As Integer Set Ma_plage = Worksheets("DP").Range(Cells(Premiereligne, 13), Cells(derniereligne - 1, 13)) For Each Cell In Ma_plage If Cell.Value > semainedebut And Cell.Value <= semainefin Then Cell.EntireRow.Interior.ColorIndex = 27 Cell.Interior.ColorIndex = 4 Rows(Cell.Row + nbdeligneainserer).insertshifht xlDown End If Next Cell End Sub
Merci par avance!

Bonjour,

Attention, beaucoup de personnes n'ouvrent pas les fichiers joints => à lire : https://www.developpez.net/forums/d8...s-discussions/
Il vaut mieux que tu expliques avec des captures d'écran.

Est-ce que tu peux nous dire plus précisemment là où tu bloques ? Est-ce que tu ne sais pas quelle requête utiliser pour insérer des lignes ? Est-ce que tu as un message d'erreur lorsque tu lances ton code ? Si oui lequel ?
Merci :)

Néanmoins quelques remarques :
Ton code :
Code:

1 2 3 4 5 6 7 8 9 Premiereligne = I derniereligne = I + 1 Do While Range("B" & derniereligne) = Mon_projet And Range("B" & Premiereligne) = Mon_projet And Range("B" & derniereligne) = Range("B" & Premiereligne) derniereligne = derniereligne + 1 Loop
J'imagine que là, tu cherches à trouver la première ligne avec Mon_projet et la dernière ligne avec Mon_projet. Tu peux faire ça sans boucle avec la fonction Find. Cela t'évitera de faire une boucle.
Code:

1 2 Premiereligne = Range("B:B").Find(Mon_projet, , , , , xlNext).Row dernierligne = Range("B:B").Find(Mon_projet, , , , , xlPrevious).Row
xlNext permet de chercher dans le sens de haut en bas (donc de trouver la première occurrence).
xlPrevious permet de chercher dans le sens de bas en haut (donc de trouver la dernière occurrence).
=> du coup, même pas besoin des variables I et bonnecolonne
Ton code :
Code:

1 2 Range(Cells(Premiereligne, 1), Cells(derniereligne - 1, 17)).Select Selection.Interior.ColorIndex = 17
Evite les Select. Cela peut vite entraîner des erreurs => tu penses avoir sélectionné qqc et finalement c'est une autre cellule qui reçoit l'instruction etc ... En plus, dans 99% des cas, ils sont inutiles. Ecris plutôt, tout simplement :

Code:

Range(Cells(Premiereligne, 1), Cells(derniereligne - 1, 17)).Interior.ColorIndex = 17

Est-ce que tu comprends bien la logique ?
Petite remarque de forme sur tes variables. Evite de prendre des noms qui ressemble à des fonctions. Tu utilises par exemple une variable Cell, alors qu'il existe la propriété Cells. Cela peut vite porter à confusion et tu risques de faire des erreurs (et chercher longtemps où est l'erreur ... ;) ) Et fais attention à la cohérence des noms avec le type de variable. Tu utilise macell pour un nombre entier. Il vaut mieux utiliser des noms explicite qui sont cohérents avec les types de variables pour éviter de faire des erreurs. Tu verras ça clarifiera des choses ;). D'ailleurs, tu n'utilises pas cette variable macell... Donc pas la peine de la déclarer.
Enfin, ton code :

Code:

Rows(Cell.Row + nbdeligneainserer).insertshifht xlDown

J'ai fait une recherche google : insertshifht, ça n'existe pas. Je pense que tu cherches à utiliser la fonction Insert. Est-ce que tu vois comment l'utiliser dans ton cas ?
J'attends ton retour avec les modifs pour voir si cela t'a permis de résoudre ton problème.
A bientôt :)

22/03/2020, 11h14
lima68

Merci pour le retour super complet!

En effet la boucle est peut etre inutile je viens de tester ta solution qui est super.

Mon gros probleme est que Je n'arrive pas a inserer des lignes (nombre variables) apres la bonne ligne trouvee. En effet ma formulation etait fausse, J'ai essaye des formules du type:

Code:

Rows(Cell.Row + 1, 4).Insert shift:=xlDown

ou encore

Code:

Rows (cells).Insert shift:=xlDown

Mais j'arrive souvent a inserer des lignes jusque la fin de mon tableau et Excel plante...

Par contre je vais changer le nom"Cell" pour quelque chose d'autre, encore merci!

PS: Desolee pour les fautes j'ai un clavier anglais

Quand j'utilises l'enregistreur de macro, j'ai la syntaxe suivante pour insérer une ligne au-dessus de la ligne 5 :

Code:

Rows("5:5").Insert Shift:=xlDown

En fait, tu as le choix entre cette syntaxe ou :

Code:

Rows(5).Insert Shift:=xlDown

Il faut donc que tu repères le numéro de la ligne. L'attribut de la fonction Rows n'est pas une cellule (ce que tu essaies de lui faire avaler dans tes exemples), mais un nombre.

Du coup, si je reprends cette partie de ton code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim Ma_plage As Range Dim Cell As Range Dim macell As Integer Set Ma_plage = Worksheets("DP").Range(Cells(Premiereligne, 13), Cells(derniereligne - 1, 13)) For Each Cell In Ma_plage If Cell.Value > semainedebut And Cell.Value <= semainefin Then Cell.EntireRow.Interior.ColorIndex = 27 Cell.Interior.ColorIndex = 4 Rows(Cell.Row + nbdeligneainserer).insertshifht xlDown End If Next Cell
J'écrirais :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Dim i As Integer Dim j As Integer For i = Premiereligne To dernierligne - 1 'on se balade entre le lignes "Premierligne" et "dernierligne - 1" If Cells(i, 13).Value > semainedebut And Cells(i, 13).Value <= semainefin Then Cells(i, 13).EntireRow.Interior.ColorIndex = 27 Cells(i, 13).Interior.ColorIndex = 4 Rows(i & ":" & i + nbdeligneainserer - 1).Insert xlDown '*explication ci-dessous End If Next i
* explication :
Sur Excel, à la main, quand on veut insérer n lignes au-dessus de la ligne i, on fait la chose suivante :

Sélectionner la ligne i et les n-1 lignes en-dessous (on a donc sélectionné n lignes dont la ligne i)
Cliquer sur le bouton insérer.

C'est ce que j'ai fait avec l'enregistreur de macro et ça nous donne une macro assez logique. Si par exemple, tu veux insérer 3 lignes au-dessus de la ligne 5, tu auras :

Code:

Rows("5:7").Insert xlDown

Or 5 = 5 + 3 -1 = ligne au-dessus de laquelle on veut insérer + nb de lignes à insérer - 1.
Avec i et nbdeligneainserer, ça donne l'intervalle [i; i + nbdeligneainserer - 1]. Si on veut respecter l'écriture du code avec les "" et les deux-points, on a donc :

Code:

Rows(i & ":" & i + nbdeligneainserer - 1).Insert xlDown

Est-ce que c'est clair ?