如何修复不使用PasteSpecial复制图到新表的图形

Question

按下按钮时，我有一个VBA宏，可以从活动工作表中复制信息，打开一个新的工作簿，然后将复制的数据粘贴到“ sheet1”中。当我使用“ ActiveSheet.Paste”命令时，所有文本和图形都将被复制，但列宽不会被复制。当我使用“ PasteSpecial”时，文本和适当的列宽会转移，但所有图形都不会。

请参见下面的代码：

下面的代码复制了所有文本和图形，但没有粘贴列宽，因此结果确实很丑

Range("A1:W500").Select
Selection.Copy 'copies the range above
Windows(NewWorkBookName).Activate 'activates the new workbook again
ActiveSheet.Paste

下面的代码粘贴适当的列宽，但不粘贴图形。

Sheets("Dashboard").Range("A1:Z500").Copy
Windows(NewWorkBookName).Activate
With Sheets("Sheet1").Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteAllUsingSourceTheme
    End With
    Application.CutCopyMode = False

知道发生了什么，如何解决？谢谢！

Answer 1

Option Explicit

Sub Copy1()
'code sample 1 from OP:
'The code below copies all of the text and graphs, but doesn’t paste column widths so the result is really ugly
Range("A1:Z500").Copy
Workbooks.Add           'adds new workbook
ActiveSheet.Paste
End Sub

Sub Copy2()
'code sample 2 from OP:
'The code below pastes the proper column widths, but not the graphs.
Range("A1:Z500").Copy
Workbooks.Add           'adds new workbook
With ActiveSheet.Range("A1")
    .PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteAllUsingSourceTheme
End With
Application.CutCopyMode = False
End Sub

Sub Copy3()
'the regular copy + copy ColumnWidths approach (proposed by Tim Williams)
Dim oldWb As Workbook
Dim oldWs As Worksheet
Dim newWb As Workbook

'regular copy => does not copy column width
Set oldWb = ActiveSheet.Parent
Set oldWs = ActiveSheet
Range("A1:Z500").Copy
Set newWb = Workbooks.Add           'adds new workbook
ActiveSheet.Paste

'copy columnwidths => does not copy graphs
oldWs.Range("A1:Z500").Copy
With ActiveSheet.Range("A1")
    .PasteSpecial xlPasteAll
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteAllUsingSourceTheme
End With
Application.CutCopyMode = False
End Sub

Sub Copy4()
'if the full column is selected the column width and graphs are copied to the new sheet
Range("A:Z").Copy
Workbooks.Add           'adds new workbook
ActiveSheet.Paste
End Sub

Sub Copy5()
'if the whole sheet is copied the column width and the graphs are copied
ActiveSheet.Copy        'copy activeSheet to a new workbook
End Sub