Sub Test()
Dim i As Long, rech As String, lig As Long
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet2")
For i = 1 To .Range("B" & .Rows.Count).End(xlUp).Row
If .Range("B" & i).Value Like "oriflamme*" And IsNumeric(.Range("D" & i).Value) Then
lig = .Range("D" & i).Value
rech = ThisWorkbook.Sheets("Sheet3").Range("Liste").Cells(i, 2).Value
If rech <> "" Then
ThisWorkbook.Sheets("Sheet5").Shapes(.Range("B" & i).Value).Copy
rech = Right(rech, Len(rech) - InStrRev(rech, "!"))
ThisWorkbook.Sheets("Sheet6").Activate
ActiveSheet.Range(rech).Select
ActiveSheet.Paste
End If
End If
Next i
Application.ScreenUpdating = True
End With
End Sub