一旦按下按钮,我有一个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
任何想法是怎么回事,我该怎么解决这个问题?谢谢!!
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