Sub Archiver_test()
Dim Source As Worksheet, Desti As Worksheet, N1&
'ci-dessous adapter le nom des feuilles
Set Source = Sheets(1): Set Desti = Sheets(2)
N1 = 6
While Source.Cells(N1, "B").Value <> ""
Source.Rows(N1).Copy Desti.Cells(Rows.Count, 1).End(3)(2)
Application.CutCopyMode = False
N1 = N1 + 1
Wend
End Sub