Macro - Ebene kopieren

[norre]

Hallo,
ich habe mir ein Macro aufgezeichnet, dass die aktive Ebene der aktuellen Seite kopiert und den Namen "Kopie von akt. Ebene" vergibt.
So, ich als Macrodummy bringe es natürlich nicht fertig, dass dies dann im ganzen Dokument durchläuft und eventuell sogar dem Namen der aktuellen Ebene übernimmt und z.B Kopie mit anhängt.
Jemand ;-) eine Idee

Sub Kopie_von_akt_Ebene()
' Recorded 04.11.2013
ActiveLayer.Shapes.All.CreateSelection
ActiveSelection.Copy
Dim lr1 As Layer
Set lr1 = ActivePage.CreateLayer("Kopie von akt.Ebene")
lr1.Shapes.All.CreateSelection
Dim grp1 As ShapeRange
Set grp1 = ActiveSelection.UngroupEx
Dim pasteopt As StructPasteOptions
Set pasteopt = CreateStructPasteOptions
With pasteopt.ColorConversionOptions
.SourceColorProfileList = "ECI-RGB.icc,ISO Coated v2 (ECI),Dot Gain 15%"
.TargetColorProfileList = "ECI-RGB.icc,ISO Coated v2 (ECI),Dot Gain 15%"
End With
Dim Paste1 As ShapeRange
Set Paste1 = lr1.PasteEx(pasteopt)
End Sub