Discussion :

[lima68]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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!