Усовершенствование кода по переносу диаграмм - VBA

Формулировка задачи:

Подскажите пожалуйста, есть хороший нижеуказанный код по переносу и формированию всех диаграмм с одного листа на другой, но у меня очень много листов в эксель файлах, подскажите пожалуйста как можно изменить код чтоб выводил на активный лист все диаграммы без предварительного изменения кода, проще говоря нажал на каком нибуть листе макрос и диаграммы бы перенеслись на этот лист и сформировались и ненужно было бы отслеживать место расположения диаграмм чтоб их перенести

                    Листинг программы
                
 
                        
                          
                    
Private Sub Test()
    Dim iChart As ChartObject, iSerie As Series
    Dim list1$, list2$: list1 = "Лист1": list2 = "Лист2"
    
    Application.ScreenUpdating = False
    For Each iChart In Worksheets(list1).ChartObjects
        For Each iSerie In iChart.Chart.SeriesCollection
            iSerie.Formula = Replace(iSerie.Formula, list1, list2)
        Next
        iChart.Chart.Location xlLocationAsObject, list2
    Next
    Application.ScreenUpdating = True
End Sub

Решение задачи: «Усовершенствование кода по переносу диаграмм»

textual
                            Листинг программы 
                        
 
                        
                          
                    
Public Sub Test()
    Dim iChart As ChartObject, iSerie As Series, Sh As Worksheet
    Dim list1$, list2$ 
    
    list2$ = ActiveSheet.Name
    Application.ScreenUpdating = False
    For Each Sh In Worksheets
        If Not ActiveSheet Is Sh Then
            list1$ = Sh.Name
            For Each iChart In Sh.ChartObjects
                For Each iSerie In iChart.Chart.SeriesCollection
                    iSerie.Formula = Replace(iSerie.Formula, list1, list2)
                Next
                iChart.Chart.Location xlLocationAsObject, list2
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub