Sub Transfert_Nom_Image()
Application.ScreenUpdating = False
Dim i As Long
Dim NbLigne As Long, NumLigne1 As Long, NumLigne2 As Long, Boucle As Long
Sheets("Contenu de répertoire").Select
For i = 1 To Range("B65536").End(xlUp).Row
If Range("A" & i) = 8 Then
NumLigne1 = i + 1
NumLigne2 = Range("A" & i).End(xlDown).Row - 1
For Boucle = NumLigne1 To NumLigne2
If Right(Range("B" & Boucle), 3) = "jpg" Or Right(Range("B" & Boucle), 3) = "gif" Then
Range("B" & Boucle).Copy
Range("C" & i).PasteSpecial xlPasteValues
End If
Next Boucle
End If
Next i
Application.ScreenUpdating = True
End Sub