Ajouter des lignes manquantes

[colaplsus]

Bonjour bonjour à tous, voici mon probleme, au tout départ j'ai une liste de valeurs tel que celle ci :

0 18/05/2011 07:30 4127
2 18/05/2011 07:30 4127
3 18/05/2011 12:00 4144
0 18/05/2011 13:02 4127
1 18/05/2011 18:10 4144
2 18/05/2011 07:34 4127
3 18/05/2011 12:05 4144
0 18/05/2011 13:02 4127
1 18/05/2011 17:04 4145
2 18/05/2011 13:59 4127
3 18/05/2011 18:18 4145
0 18/05/2011 08:55 4149
1 18/05/2011 12:05 4149
2 18/05/2011 13:02 4149
3 18/05/2011 14:11 4149
0 18/05/2011 07:52 4149
1 18/05/2011 12:44 4149
2 18/05/2011 13:40 4149
3 18/05/2011 17:11 4149
0 18/05/2011 08:39 4149
1 18/05/2011 12:05 4149
2 18/05/2011 13:02 4149
3 18/05/2011 16:44 4149
0 18/05/2011 16:12 4149
1 18/05/2011 19:29 4149
2 18/05/2011 13:18 4149

qui répertorie les entrées et sorties des employés, tel que
0 = entrée 1
1 = sortie 1
2 = entrée 2
3 = sortie 2
avec ensuite la date, l'heure et le matricule
Malheureusement, certaines personnes oublient de passer et d'indiquer une entrée ou une sortie ce qui sur une journée au lieu de faire 0 1 2 3 on aurait 0 2 3 ou des choses comme cela, ainsi je cherche comment ajouter ces entrées manquantes, c'est a dire que sur 3 lignes ou on aurait
0
1
3
hop une nouvelle ligne s'ajoute entre 1 et 3 pour faire :
0
1
2
3

J'avais d'abord pensé à ce code

Sub oubli()
Dim i As Integer
Dim x As Integer
x = 0
i = 1
While i < 25
If Cells(i + 1, 1).Value - Cells(i, 1).Value <> 1 Then
Cells(i + 1, 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(i, 1).Select
    Selection.Copy
    Cells(i + 2, 1).Select
    ActiveSheet.Paste
    Cells(i + 2, 1).Value = Cells(i, 1) + 1
    Cells(i, 2).Select
    Application.CutCopyMode = False
    Selection.Copy
    Cells(i + 2, 2).Select
    ActiveSheet.Paste
    Cells(i, 4).Select
    Application.CutCopyMode = False
    Selection.Copy
    Cells(i + 2, 4).Select
    ActiveSheet.Paste
End If
i = i + 1
Wend
    

End Sub

Mais il ne semble pas fonctionner, quelqu'un aurait une idée à me proposer ?.

 

[Dranreb]

Re : Ajouter des lignes manquantes

Bonjour.
Comme ceci peut être:

Sub oubli()
Dim i As Long
For i = 1 To 500
   If Cells(i, 1).Value = "" Then Exit Sub
   If Cells(i, 1).Value <> (i - 1) Mod 4 Then
   Rows(i).Copy: Rows(i).Insert xlShiftDown
   Cells(i, 1).Value = (i - 1) Mod 4
   Next i
End Sub

À+