Inserer plusieurs photos dans des cellules différentes VBA sans bouton

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim p As Picture
If Sh.Name <> "Tableau" And Target.Address = "$A$14" Then
    For Each p In Sh.Pictures
        p.Visible = p.Name Like "*" & Target
    Next
End If
End Sub

Sub ImportImg()
Dim a, w As Worksheet, c As Range, x$, i As Byte, nomimage$, cible As Range, Image As Picture
a = Array("C6", "L11", "L21") 'adresses des cellules des photos
For Each w In Worksheets
    If w.Name <> "Tableau" Then
        w.Pictures.Delete 'RAZ
        For Each c In [ID] 'nom défini ID pour la liste de validation
            If c <> "" Then
                x = ThisWorkbook.Path & "\" & c
                For i = 1 To 3
                    nomimage = x & "_" & i & ".jpg"
                    If Dir(nomimage) <> "" Then
                        Set cible = w.Range(a(i - 1))
                        Set Image = w.Pictures.Insert(nomimage)
                        With Image
                            .ShapeRange.LockAspectRatio = msoFalse
                            .Left = cible.Left
                            .Top = cible.Top
                            .Height = cible.MergeArea.Height
                            .Width = cible.MergeArea.Width
                            .Name = i & "_" & c
                        End With
                    End If
                Next i
            End If
        Next c
    End If
    w.[A14] = w.[A14] 'lance la macro Workbook_SheetChange
Next w
End Sub

        For Each Image In w.Pictures
            If Not UCase(Image.Name) Like "LOGO*" Then Image.Delete
        Next Image

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim p As Picture
If Sh.Name <> "Tableau" And Target.Address = "$A$14" Then
    For Each p In Sh.Pictures
        p.Visible = p.Name Like "*" & Target Or UCase(p.Name) Like "LOGO*"
    Next
End If
End Sub