Sub PlaceImages()
Dim myRange As Range, cellule As Range, chemin As String, extension As String
chemin = "C:\Users\8248425\Desktop\forum image\"
extension = ".tif"
With ActiveWorkbook.Worksheets("BOOK")
Set myRange = .Range("E5:E" & .Cells(Rows.Count, 5).End(xlUp).Row).Offset(0, 1)
For Each cellule In myRange
If Dir(chemin & cellule.Offset(0, -1).Text & extension) <> "" Then
Set monImage = .Pictures.Insert(chemin & cellule.Offset(0, -1).Text & extension)
monImage.Left = cellule.Left + 1
monImage.Top = cellule.Top + 1
End If
Next
End With
End Sub