Ligne en trop

Sub fact_articles()
    Dim Cel As Range
    Dim Ligne_mouv As Long
    Application.ScreenUpdating = False
    With Worksheets("Mouv_ventes")
        .Activate
        .Unprotect
        For Each Cel In Range("ref_vente")
            Ligne_mouv = Worksheets("Mouv_ventes").Cells(Rows.Count, "A").End(xlUp).Row + 1
            If Not IsEmpty(Cel) Then
                .Cells(Ligne_mouv, 1).Value = Cel.Offset(0, 0)
                .Cells(Ligne_mouv, 2).Value = Cel.Offset(0, 1)
                .Cells(Ligne_mouv, 3).Value = Cel.Offset(0, 2)
                .Cells(Ligne_mouv, 4).Value = Format(Now, "dd/mm/yyyy")
                .Cells(Ligne_mouv, 5).Value = Worksheets("Facture_Devis").Range("K2")
                .Cells(Ligne_mouv, 6).Value = Worksheets("Facture_Devis").Range("L2")
                '.Cells(Ligne_mouv, 7).Value = Range("N°_fact") 'Worksheets("Facture_Devis").Range("L2")
            End If
        Next Cel
        .Protect
    End With
    Application.ScreenUpdating = True
End Sub