Bom dia!!!

Preciso armazenar o nome do gráfico em uma variável, já fiz várias pesquisas e não consegui obter resultado.Porque toda vez, que executo esta macro o nome do grafico muda.Grafico 2, Grafico 3 e assim por diante, ai como o nome do grádico vai sempre estar como Grafico 1 ele da erro na macro.

Sub InserirGrafico()
'
' InserirGrafico Macro
'

'
' Preciso pegar o nome do grafíco e armazenar em uma varíavel, mas não estou achando o comando exato
' que faça isso. trocar o nome da variavel pelo nome "Grafico 1"

    Dim NomeGrafico As String
    
    
    Range("A6").Select
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.ApplyChartTemplate ( _
        "C:UserscelsotdsAppDataRoamingMicrosoftTemplatesChartsRecorrencia.crtx" _
        )
     ' Criei a linha abaixo NomeGrafico e msgbox mas quando ele executa a linha abaixo NomeGráfico ele da erro 
     NomeGrafico = Shape.Name
     msgbox NomeGráfico
     ActiveChart.SetSourceData Source:=Range("Planilha2!$A$3:$F$9")
    ActiveSheet.Shapes("Gráfico 1").IncrementLeft -183
    ActiveSheet.Shapes("Gráfico 1").IncrementLeft -183
    ActiveSheet.Shapes("Gráfico 1").IncrementTop 115.5
    ActiveSheet.Shapes("Gráfico 1").ScaleWidth 1.8583333333, msoFalse, _
        msoScaleFromTopLeft
    ActiveWindow.SmallScroll Down:=6
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
    ActiveChart.FullSeriesCollection(3).Select
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
    ActiveChart.FullSeriesCollection(4).Select
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
    Range("G17").Select
End Sub

Aguardo retorno.

Grato