Sub Archivage_2()
Dim i&, J&, Rw&, Tdata As Variant
With Sheets("Formulaire")
Tdata = .Range(.Cells(16, 2), .Cells(.Rows.Count, 2).End(3)(1, 8))
End With
For i = LBound(Tdata, 1) To UBound(Tdata, 1)
If Tdata(i, 1) <> 0 Then
Rw = Rw + 1
For J = LBound(Tdata, 2) To UBound(Tdata, 2)
Tdata(Rw, J) = Tdata(i, J)
Next J
End If
Next i
With Sheets("Base")
.Cells(.Rows.Count, 2).End(3)(2).Resize(Rw, UBound(Tdata, 2)).FormulaLocal = Tdata
.Activate
End With
End Sub