excel - 如何在 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

I am trying to make it work on creation of a new sheet. My knowledge of vba is zero so I'm sure it is not the correct way, however I have managed to get it work. I will add it as an answer. Please comment if there is a better way! – aye cee 2 mins ago

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

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