VBA一次复制多个图表

Question

我在工作表上总共有10张图表，其中5张以SI单位表示，其他5张以ANSI表示。 每个都分为两个单独的列。 5个ANSI图表在“ F”列中垂直对齐。 5个SI图表在“ O”列中垂直对齐。

我只想复制“ F”列中的图表。

我要如何一次全部复制它们？

我目前一次将它们复制一次

码：

wb.Sheets(w).ChartObjects("Chart 9").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range( "F2").Select
    .Pictures.Paste
End With
wb.Sheets(w).ChartObjects("Chart 13").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F17").Select
    .Pictures.Paste
End With

wb.Sheets(w).ChartObjects("Chart 14").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F32").Select
    .Pictures.Paste
End With

wb.Sheets(w).ChartObjects("Chart 15").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F47").Select
    .Pictures.Paste
End With

wb.Sheets(w).ChartObjects("Chart 16").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F64").Select
    .Pictures.Paste
End With

示例如何排列；

Answer 1

在一个循环中，您可以执行以下操作：

Dim chartPasteRow as integer

chartPasteRow = 2
For each chartName in Array("Chart 9", "Chart 13", "Chart 14", "Chart 15", "Chart 16")
    wb.Sheets(w).ChartObjects(chartName).Chart.ChartArea.Copy
    ThisWorkbook.Worksheets("Plots").Range("F" & chartPasteRow).PasteSpecial xlPasteValues
    chartPasteRow = chartPasteRow + 15
Next chartName

如果要粘贴所有图表而不必指定，则可以执行以下操作：

Dim chartPasteRow as integer

chartPasteRow = 2
For each cht In wb.Sheets(w).ChartObjects
    cht.Chart.ChartArea.Copy
    ThisWorkbook.Worksheets("Plots").Range("F" & chartPasteRow).PasteSpecial xlPasteValues
    chartPasteRow = chartPasteRow + 15
Next cht

这是假设每个图表每15行都会粘贴一次。