Ajouter des lignes manqante

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 ?

P.S : ce sujet a été écrit pour faciliter le probleme d'un sujet précédent.

-- 30 Juin 2011, 11:28 --

ya t'il quelqu'un sur le forum ?

-- 30 Juin 2011, 12:46 --

Fonctionne enfin grace à :

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
   Cells(i, 3).Value = ""
   Cells(i, 2).Value = Cells(i - 1, 2).Value
   End If
   Next i
End Sub
Rechercher des sujets similaires à "ajouter lignes manqante"