Sub creation()
Dim Rw As Range
Dim Ligne As Long
Sheets("Sheet1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
For Each Rw In Selection.Rows
Ligne = Rw.Row
If Rw.Cells(1, 17).Value = "FIM" And Rw.Cells(1, 6).Value = "EUR" Then
Rw.Copy Destination:=Worksheets("Sheet2").Cells(Ligne, 1).EntireRow
End If
Next Rw