Sub copier()
Dim derlig&, num&, sh As Worksheet, shc As Worksheet
Dim plage As Range, plg As Range, Cel As Range
Application.ScreenUpdating = False
Set sh = Sheets("Suivi de production")
Set shc = Sheets("Suivi de commande")
Set plage = Selection
plage.Copy
Set plg = sh.Range("c" & Rows.Count).End(3)(2)
plg.PasteSpecial xlPasteValues
Application.CutCopyMode = 0
With sh
derlig = .Range("c" & Rows.Count).End(xlUp).Row
x = .Range("a" & Rows.Count).End(xlUp).Row + 1
num = 0
.Range(.Cells(x, 1), .Cells(derlig, 1)) = Date + 1
For Each Cel In .Range("a3:a" & derlig)
If Cel = Cel.Offset(-1, 0) Then
num = num + 1
Cel.Offset(0, 1) = num
Else
num = 1
Cel.Offset(0, 1) = num
End If
Next Cel
End With
Application.Goto sh.Range("a" & derlig)
shc.Activate
plage.EntireRow.Delete
End Sub