Sub Registre()
Dim dl As Integer
Dim i As Integer
dl = Sheets("PERS 13").Cells(Application.Rows.Count, 1).End(xlUp).Row
For i = 2 To dl / 2
With Sheets("PERS 13")
.Range("A2").Copy Sheets("vendredi 31").Range("C1")
.Range("B2:D3").Copy Sheets("vendredi 31").Range("C3")
.Rows("2:3").Delete Shift:=xlUp
End With
Sheets("vendredi 31").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i
End Sub