Problème d'insertion de ligne

Bonjour!

J'ai une demande assez urgente car le programme doit tourner cet après midi

Il est fonctionnel mais quand je réalise 2 demandes de mesure, puis les soldes l'une après l'autre, des lignes disparaissent, et il y en a qui remplacent d'autre

Les demandes se réalisent feuille "Demande", elles se soldent feuille "Résultat",et le problème se trouve feuille "Demande" pour la passage des pièces dans les pièces terminées.

Le code concerné se trouve dans (Feuil1 Résultat) et est le suivant:

If Target.Address = "$K$7" Or Target.Address = "$K$8" Or Target.Address = "$K$9" Then 'Si les cellules qui changent sont K7 ou K8
        Call HeureK9
            For i = 4 To 20
                If Sheets("demande").Range("F" & i).Value = 240 Then  'On cherche les pièces de la machine à mesurer
                    Sheets("Demande").Range("I4").Value = Sheets("Demande").Range("A" & i).Value  'Transmet les données vers les pièces terminées
                    Sheets("Demande").Range("J4").Value = Sheets("Demande").Range("B" & i).Value
                    Sheets("Demande").Range("K4").Value = Sheets("Demande").Range("C" & i).Value
                    Sheets("Demande").Range("L4").Value = Sheets("Demande").Range("D" & i).Value
                    Sheets("Demande").Range("O4").Value = Format(Time, "h:mm;@")
                    Sheets("Demande").Range("O4").Value = Sheets("Demande").Range("H" & i).Value
                    Sheets("Demande").Range("M4").Value = Sheets("Demande").Range("E" & i).Value
                    Sheets("Demande").Range("N4").Value = Format(Time, "h:mm;@") 'La cellule L4 devient l'heure
                    Sheets("Demande").Range("P4").Value = Format(Time, "h:mm;@")        ' pour donner un format à la cellule avant d'y écrire
                    Sheets("Demande").Range("P4") = CDate(Sheets("Demande").Range("N4")) - CDate(Sheets("Demande").Range("G" & i)) 'Temps pris pour mesurer
                    x = CDate(Sheets("Demande").Range("H" & i)) - CDate(Sheets("Demande").Range("P4")) 'Compare le temps mis au temps attendu
                        If x > 0 Then
                            Sheets("Demande").Range("Q4").Value = "Avance"
                            ElseIf x < 0 Then
                            Sheets("Demande").Range("Q4").Value = "Retard"
                            x = -x
                        End If
                    Sheets("Demande").Range("R4").Value = Format(Time, "h:mm;@") 'Donne un format à la cellule
                    Sheets("Demande").Range("R4").Value = x 'Prend la vameur de l'écart entre temps attendu et temps mis
                    y = 5
                    For n = i + 1 To i + 10
                        If Sheets("Demande").Range("B" & n).Value <> "" Then GoTo 2
                            If Sheets("Demande").Range("D" & n).Value <> "" Then
                                Sheets("Demande").Rows(y).Insert
                                Sheets("Demande").Rows(y).Locked = False
                                Sheets("Demande").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
                                Sheets("Demande").Range("L" & y).Value = Sheets("Demande").Range("D" & n + 1).Value
                                Sheets("Demande").Range("M" & y).Value = Sheets("Demande").Range("E" & n + 1).Value
                                n = n + 1
                                Sheets("Demande").Range("D" & n).ClearContents
                                Sheets("Demande").Range("E" & n).ClearContents
                                y = y + 1
                            End If
                    Next n
2
                            Sheets("Demande").Range("B" & i).ClearContents 'Vide les pièces à mesurer
                            Sheets("Demande").Range("C" & i).ClearContents
                            Sheets("Demande").Range("D" & i).ClearContents
                            Sheets("Demande").Range("E" & i).ClearContents
                            Sheets("Demande").Range("A" & i).ClearContents
                            Sheets("Demande").Range("F" & i).ClearContents
                            Sheets("Demande").Range("G" & i).ClearContents
                            Sheets("Demande").Range("H" & i).ClearContents
                     End If
            Next i
    End If

PS: Florian73, tes idées d’allègement seront bien sur prises en compte, mais le programme que tu m'avais donnée était trop loin d'être fonctionnel et j'ai des demandes pour cet aprèm.

Pliiiz, j'ai beau tout essayer je n'y arrive pas

Rechercher des sujets similaires à "probleme insertion ligne"