循环浏览包含图形的工作表，将两个 ChartObject 复制到另一个工作表中 [已关闭]-解网

问：

想改进这个问题吗？通过编辑这篇文章来更新问题，使其仅关注一个问题。

3年前关闭。

改进此问题

在我的工作簿中，我有多个工作表，每个工作表包含 2 个图形——我想遍历这些工作表，将 ChartObjects（1）和 ChartObjects（2）并排复制到另一个名为“Graphs”的工作表中。

为了澄清，包含 2 个图形的工作表被命名为“John”、“Paul”、“George”和“Ringo”。我想首先选择工作表“John”，将 ChartObjects（1）复制到“Graphs”的单元格 A3 中，然后将 ChartObjects（2）复制到“Graphs”的单元格 K3 中，接下来我想选择“Paul”并将 ChartObjects（1）复制到“Graphs”的单元格 A24 中，将 ChartObjects（2）复制到“Graphs”的单元格 K24 中，依此类推“George”、“Ringo”等。

我已经研究了这个问题，但找不到将 2 个 ChartObjects 从一张纸并排复制到另一张纸上的解决方案，因此我目前正在使用一种代码，该代码只是依次选择每个工作表并复制/粘贴图表 - 我相信有更好的方法，不幸的是，它超出了我有限的 VBA 技能。

注意

按照要求，我已经更新了我原来的问题，@Harassed爸爸好心地提供了解决方案。

VBA 循环 Office365 Excel 图表

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

循环浏览包含图形的工作表，将两个 ChartObject 复制到另一个工作表中 [已关闭]

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

注意

评论

评论