Sub Archivage()
With Sheets("Historique_BC")
For L = 1 To 5
If Cells(L + 5, "D") <> "" Then
DL = .Range("A65500").End(xlUp).Row + 1
.Cells(DL, "A") = [A14]
.Cells(DL, "B") = [A2]
.Cells(DL, "C") = Cells(L + 5, "A")
.Cells(DL, "D") = Cells(L + 5, "B")
.Cells(DL, "E") = Cells(L + 5, "C")
.Cells(DL, "F") = Cells(L + 5, "D")
End If
Next L
End With
[A6:D10].ClearContents: [A13] = "": [A2] = [A2] + 1
End Sub