Bild per VBA einfügen

Private Sub CommandButton3_Click()
Dim rng As Range, rngA As Range
Dim vntret As Variant
Set rngA = ActiveCell
For Each rng In Range("z20:z50")
vntret = Application.Match(rng, Sheets("Kantenbild").Range("c1:C30"), 0)
If IsNumeric(vntret) And rng <> "" Then
erasePic rng
copyPic rng.Offset(0, -4), CLng(vntret)
Else
erasePic rng
End If
Next
rngA.Select
End Sub

Private Sub erasePic(Target As Range)
Dim objPic As Shape
For Each objPic In Me.Shapes
If objPic.TopLeftCell.Row = Target.Row Then
objPic.Delete
Exit Sub
End If
Next
End Sub

Private Sub copyPic(Target As Range, Index As Long)
Dim objPic As Shape, objCopy As Shape
With Sheets("Kantenbild")
For Each objPic In .Shapes
If objPic.TopLeftCell.Row = Index Then
objPic.Copy
Me.Paste
Set objCopy = Me.Shapes(Me.Shapes.Count)
objCopy.Left = Target.Left
objCopy.Top = Target.Top
Exit Sub
End If
Next
End With
End Sub