Hallo zusammen,

ich bräuchte mal wieder eure Hilfe :)

In meiner Excel Tabelle (siehe Beispieldatei) im Reiter "Trim F" werden automatisch Bilder aus dem Reiter "Vorlage" in die Zelle eingefügt wenn ich dort ein x einfüge. C4:C500 und D4:D500

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Dim Bild As Shape, LR As Long
LR = Cells(Rows.Count, 2).End(xlUp).Row

If Not Intersect(Target, Range("C4:C500" & LR, "D4:D500" & LR)) Is Nothing Then
Select Case Target.Column
Case 3
Set Bild = Tabelle3.Shapes("Grafik 1")
Case 4
Set Bild = Tabelle3.Shapes("Grafik 2")
End Select

If LCase(Target.Cells) = "x" Then
Bild.Copy
Application.EnableEvents = False
With Target.Cells
.PasteSpecial
.Activate
End With
End If
End If

'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub


Das funktioniert ohne Probleme
Nun möchte ich das mit 2 anderen Bildern auf E4:E500 (Grafik 3) & F4:F500 (Grafik 4, die gibt es aber noch nicht) erweitern.
Kann mir jemand helfen wie ich den Code dazu ändern muss?

Vielen Dank im Voraus
Beste Grüße
Stefan

https://www.herber.de/bbs/user/175031.xlsm