Sub imprimer()
Application.ScreenUpdating = False
Dim Lig As Long
Dim F2 As Worksheet, F3 As Worksheet
Dim x
Set F2 = Sheets("Rapport")
Set F3 = Sheets("Imprimé")
With F3
For Lig = 1 To F2.[A65536].End(xlUp).Row
If F2.Cells(Lig, "A") = .Cells(6, "B") Then
F2.Range(F2.Cells(Lig, "D"), F2.Cells(Lig, "G")).Copy
F.Cells(F.Cells(65536, "D").End(xlUp)(2).Row, _
"A").PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
.Range(.Cells(10, 1), .Cells(49, 4)).ClearContents
End With
Application.ScreenUpdating = True
End Sub