如何在Excel VBA中粘贴所有形状和列宽

Question

我使用下面的代码将一行粘贴到每个新工作表上。我正试图让它粘贴所有内容，包括形状和列宽。ActiveSheet.Paste包括形状，但不包括列宽。我尝试过Sh.Range("1:1").PasteSpecial xlPasteAll，但它既不粘贴形状也不粘贴列宽。

我知道我需要合并xlPasteColumnwidths，但我知道如何使用ActiveSheet.Paste。

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sheets("Template").Range("1:1").Copy
Sh.Range("1:1").Select
ActiveSheet.Paste

End Sub

Answer 1

这就是您正在尝试的吗？

Dim wsInput As Worksheet, wsOutput As Worksheet
Set wsInput = Sheets("Template")
Set wsOutput = Sheets("Whatever") '<~~ Change as applicable
wsInput.Rows(1).Copy wsOutput.Rows(1)
wsInput.Rows(1).Copy
wsOutput.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

我正在努力让它在创建新工作表时发挥作用。我对vba的了解为零，所以我确信这不是正确的方法，但我已经设法让它发挥作用了。我将补充它作为一个答案。如果有更好的方法，请评论是的，2分钟前

如果要在添加新工作表时执行复制粘贴，则需要对上述代码进行轻微修改，如下所示。

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim wsInput As Worksheet

Set wsInput = Sheets("Template")

wsInput.Rows(1).Copy Sh.Rows(1)

wsInput.Rows(1).Copy
sh.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End Sub

Answer 2

我已经接受了Siddaharth上面的答案，它运行得很好。只是想我会发布我之前提出的解决方案。我对vba知之甚少，所以这可能效率低下，但它就在这里。

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sheets("Template").Range("1:1").Copy
Sh.Range("1:1").Select
ActiveSheet.Paste
Sh.Range("1:1").PasteSpecial Paste:=xlPasteColumnWidths 
End Sub