Hallo zusammen,

im Zusammenhang mit der Fußball EM 2024 möchte die Flaggen der jeweiligen Länder einfügen.
Dazu habe ich den folgenden Code, der auch funktioniert:

Sub Flaggen_GruppeA()
Dim n1 As Integer, n2 As Integer
Dim Land As String
Dim FlagName As Variant
Dim FlagBereich As Range
Dim myDocument As Worksheet
Dim arrShapes As Variant, Shapes As Object

Set myDocument = Worksheets(1)
Set FlagBereich = Range("Länder_Flaggen")

' vorhandene Flaggen löschen
For n1 = 1 To 4
On Error Resume Next
If Range("GruppeA.Flag").Offset(n1, 0).Value > "" Then
ActiveSheet.Shapes(Range("GruppeA.Flag").Offset(n1, 0).Value).Delete
Range("GruppeA.Flag").Offset(n1, 0).Clear
End If
Next

' BildName in Array einlesen
ReDim arrShapes(1 To FlagBereich.Count)
For n1 = 1 To FlagBereich.Count
arrShapes(n1) = Range("Flag.Name").Offset(n1, 0).Value
Next n1

' Bild auswählen
For n1 = 1 To 4
Land = Range("GruppeA.Land").Offset(n1, 0).Value
Tabelle1.Activate ' Länder
For n2 = 1 To FlagBereich.Count
If Range("Land.Name").Offset(n2, 0).Value = Land Then
FlagName = Range("Flag.Name").Offset(n2, 0).Value
ActiveSheet.Shapes(Range("Flag.Name").Offset(n2, 0).Value).Copy
End If
Next n2
Tabelle4.Activate ' Gruppenspiele
Range("GruppeA.Flag").Offset(n1, 0).Select
ActiveCell = ActiveSheet.Paste

' Bild erhält dabei einen neuen Namen
' neuen BildNamen in ActiveCell notieren

Next n1
End Sub

Das eingefügte Bild erhält bei dieser Aktion einen neuen Namen, den ich in der activen Zelle notieren möchte.

Wie muss ich das anstellen?

Gruß
Siegfried