Sub Reagencement_test2()
Dim i&, plg As Range
For i = 2 To Cells(Rows.Count, 1).End(3).Row
Select Case VBA.Trim(Cells(i, "A"))
Case Is = "MAR", "BEL", "CAN"
Cells(i, "A").Resize(, 5).Cut Cells(i - 1, "B")
End Select
Next
Set plg = Range("B1:B" & Cells(Rows.Count, "B").End(3).Row)
plg.SpecialCells(4).EntireRow.Delete: plg.Offset(, -1).SpecialCells(4).FormulaR1C1 = "=R[-1]C"
plg.Offset(, -1) = plg.Offset(, -1).Value
[A1:F1] = Array("Description", "Code", "ID", "Date Acquisition", "Nombre", "Dernière utilisation")
[A1].CurrentRegion.Columns.AutoFit
[D:D,F:F].NumberFormat = "dd/mm/yyyy"
End Sub