XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C

Sub PlacerPhotos()
Dim chemin$, fichier$, W#, s As Shape, n%
chemin = ThisWorkbook.Path & "\TROMBINOSCOPE\"
fichier = Dir(chemin & "*.jpg") '1er fichier du dossier
Application.ScreenUpdating = False
With ActiveSheet
    .Columns(1).ColumnWidth = 12 'largeur de colonne A à adapter
    W = .Columns(1).Width 'largeur en points
    For Each s In .Shapes
        If Not Intersect(s.TopLeftCell, .Columns(1)) Is Nothing Then s.Delete 'RAZ
    Next s
    While fichier <> ""
        n = n + 1
        Set s = .Shapes.AddPicture(chemin & fichier, msoFalse, msoTrue, 0, .Rows(n + 2).Top, 0, 0)
        s.LockAspectRatio = True
        s.Width = W 'la photo prend la largeur de la cellule
        .Rows(n + 2).RowHeight = W * s.Height / s.Width + 0.7 'la cellule prend la hauteur de la photo + marge
        .Cells(n + 2, 2) = Left(fichier, Len(fichier) - 4) 'prénom et nom en colonne B
        fichier = Dir 'fichier suivant
    Wend
End With
End Sub

Sub PlacerPhotos()
Dim chemin$, fichier$, W#, s As Shape, n%
chemin = ThisWorkbook.Path & "\TROMBINOSCOPE\"
fichier = Dir(chemin & "*.jpg") '1er fichier du dossier
Application.ScreenUpdating = False
With ActiveSheet
    .Columns(1).ColumnWidth = 12 'largeur de colonne A à adapter
    W = .Columns(1).Width 'largeur en points
    For Each s In .Shapes
        If Not Intersect(s.TopLeftCell, .Columns(1)) Is Nothing Then s.Delete 'RAZ
    Next s
    .Range("B3:C" & .Rows.Count).ClearContents 'RAZ
    While fichier <> ""
        n = n + 1
        Set s = .Shapes.AddPicture(chemin & fichier, msoFalse, msoTrue, 0, .Rows(n + 2).Top, 0, 0)
        s.LockAspectRatio = True
        s.Width = W 'la photo prend la largeur de la cellule
        .Rows(n + 2).RowHeight = W * s.Height / s.Width + 0.7 'la cellule prend la hauteur de la photo + marge
        s.Name = Left(fichier, Len(fichier) - 4) 'renomme la Shape
        .Cells(n + 2, 2) = Left(fichier, Len(fichier) - 4) 'prénom et nom en colonne B
        fichier = Dir 'fichier suivant
    Wend
    With .Range("B3:B" & n + 2)
        .TextToColumns .Cells(1), Space:=True 'commande Convertir
        .EntireRow.Sort .Columns(2), xlAscending, Header:=xlNo 'tri sur la colonne C (noms)
    End With
End With
End Sub

Sub Trombino()
     Dim FSO As Object, DC As Object
    
' Si early binding :
'     Dim FSO As Scripting.FileSystemObject
'     Dim DC As Scripting.Dictionary
     Dim Wsh As Worksheet, RépTrombi As String, DébNoms As Range, DébPhotos As Range, Shp As Shape, Cible As Range, W As Double, Col, LMax, Tb
    
     RépTrombi = ThisWorkbook.Path & "\TROMBINOSCOPE"
    
     Set Wsh = Feuil1
     Set DébNoms = Wsh.[B1]   'première cellule contenant les noms
     Set DébPhotos = Wsh.[A1] 'première cellule contenant les photos
     W = DébPhotos.Width      'Largeur en point des cellules cible
    
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set DC = CreateObject("Scripting.Dictionary")
' Si early binding :
'     Set FSO = New Scripting.FileSystemObject
'     Set DC = New Scripting.Dictionary
    
     With Wsh
          Tb = .Range(DébNoms, .Cells(.Cells(.Rows.Count, DébNoms.Column).End(xlUp).Row, 2)).Resize(, 2)
     End With
    
     'Effacer les Photos précédentes si elles existent
     Col = DébPhotos.Column
     LMax = UBound(Tb, 1)
     For Each Shp In Feuil1.Shapes
          If Shp.Type = msoPicture And Shp.TopLeftCell.Column = Col And Shp.TopLeftCell.Row <= LMax Then
               Shp.Delete
          End If
     Next
    
     Set Photos = FSO.GetFolder(RépTrombi).Files
     For Each Photo In Photos
          If UCase(Photo.Name) Like "*.JPG" Then
               DC(UCase(Photo.Name)) = Photo.Path
          End If
     Next
    
     For i = 1 To LMax
          Set Cible = DébPhotos.Offset(i - 1)
          Clef = UCase(Tb(i, 1)) & " " & UCase(Tb(i, 2)) & ".JPG"
          If DC.Exists(Clef) Then
               Set s = Wsh.Shapes.AddPicture(DC(Clef), msoFalse, msoTrue, 0, Cible.Top, 0, 0)
               s.LockAspectRatio = True
               s.Width = W  'la photo prend la largeur de la cellule cible
               Cible.EntireRow.RowHeight = W * s.Height / s.Width + 0.7 'la cellule prend la hauteur de la photo + marge
          End If
     Next

End Sub