遍历包含图形的工作 sheet，将两个 ChartObject 复制到另一个 sheet

Question

在我的工作簿中，我有多个作品sheet，每个作品包含 2 个图表 – 我想遍历这些 sheet 并排复制 ChartObjects(1) 和 ChartObjects(2) -边到另一个 sheet 命名为“Graphs”。

澄清一下，包含 2 个图表的作品sheet分别命名为“John”、“Paul”、“George”和“Ringo”。我想首先 select sheet “John”，将 ChartObjects(1) 复制到“Graphs”的单元格 A3 中，然后将 ChartObjects(2) 复制到“Graphs”的单元格 K3 中，接下来我想 select“Paul”并将 ChartObjects(1) 复制到“Graphs”的单元格 A24 中，将 ChartObjects(2)复制到“Graphs”的单元格 K24 中，以此类推“George”、“Ringo”等

我已经研究了这个问题，但找不到将 2 个 ChartObjects 从一个 sheet 并排复制到另一个 sheet 的解决方案，因此我目前使用的代码只是select 每个 sheet 依次和 copy/pastes 图表 - 我确信有更好的方法不幸的是它超出了我有限的 VBA 技能。

备注

应要求，我更新了我原来的问题，@Harassed 爸爸为此提供了解决方案。

Answer 1

Sub example()
Const offsetrows = 26 ' numbers of rows to move down between copies
Dim ws As Worksheet
Dim c As ChartObject
Dim target As Worksheet
Set target = Worksheets("graphs") 'sheet to copy to
Dim t As Range
Set t = target.Range("a1") 'first cell to copy to
For Each ws In Worksheets
     Select Case ws.Name
        Case "graphs"
           'skip this sheet
        Case Else
            For Each c In ws.ChartObjects
               c.Copy
               t.PasteSpecial xlPasteAll
               Set t = t.Offset(offsetrows, 0)
 'edited code here===============
                If t.column = 1 then     'if it was in A then
                   set t = t.offset(-offsetrows,4)    Go to D
                 else
                    set t = t.offset(0,-4)     'if D then A
                 end if
     '=======================================
            Next c
      End Select
Next ws
End Sub

遍历包含图形的工作 sheet，将两个 ChartObject 复制到另一个 sheet

Loop through worksheets containing graphs, copy both ChartObjects into another sheet

excel

vba

loops

office365

excel-charts

备注