Макрос vba копирует все графики дважды, а не один раз

Question

Этот макрос vba копирует все графики на временный лист, он работает хорошо, но кажется, что каждый график копируется дважды, а не один раз. Как я могу изменить код, чтобы он не дублировал каждый график?

Sub macro1()

Dim i As Long, j As Long, k As Long
Dim adH As Long
Dim Rng As Range
Dim FilePath As String: FilePath = ThisWorkbook.Path & "\"
Dim sht As Worksheet, shtSource As Worksheet, wk As Worksheet
'===================================================================
'===================================================================
Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "ALL"
Set sht = ActiveSheet
'===================================================================
Application.ScreenUpdating = False
'===================================================================
'Excluding fixed tab, copying all charts from all tabs to ALL
For Each wk In Worksheets
    If wk.Name <> "fixed" Then
        Application.DisplayAlerts = False
            j = wk.ChartObjects.Count
                For i = 1 To j
                    wk.ChartObjects(i).Activate
                    ActiveChart.ChartArea.Copy
                    sht.Select
                    ActiveSheet.Paste
                    sht.Range("A" & 1 + i & "").Select
                 Next i
        Application.DisplayAlerts = True
    End If
Next

Answer 1

Вы просматриваете каждый лист, включая новый лист, к которому вы только что добавили диаграммы. Это причина вашего дублирования. Вам нужно будет исключить только что добавленный лист из вашего l oop ...

For Each wk In Worksheets
    If wk.Name <> "fixed" and wk.Name <> "ALL" Then
        Application.DisplayAlerts = False
            j = wk.ChartObjects.Count
                For i = 1 To j
                    wk.ChartObjects(i).Activate
                    ActiveChart.ChartArea.Copy
                    sht.Select
                    ActiveSheet.Paste
                    sht.Range("A" & 1 + i & "").Select
                 Next i
        Application.DisplayAlerts = True
    End If
Next