excel - 复制工作表并获取结果工作表对象？

Question

复制工作表时，是否有任何简单/快捷的方法来获取新工作表的工作表对象？

ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet

事实证明，.Copy 方法返回一个布尔值而不是工作表对象。否则，我本可以这样做：

set newSheet = ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet

因此，我编写了大约 25 行代码来获取该对象。列出副本之前的所有工作表，列出之后的所有工作表，并找出仅在第二个列表中的工作表。

我正在寻找一个更优雅、更短的解决方案。

score 26 · Accepted Answer

Dim sht 

With ActiveWorkbook
   .Sheets("Sheet1").Copy After:= .Sheets("Sheet2")
   Set sht = .Sheets(.Sheets("Sheet2").Index + 1)
End With

score 17 · Accepted Answer

我相信我终于解决了这个问题——它也让我发疯了！如果 MS 让 Copy 返回一个工作表对象，就像 Add 方法一样，那就太好了……

问题是，VBA 分配新复制的工作表的索引实际上是不确定的......正如其他人所指出的那样，它在很大程度上取决于隐藏的工作表。事实上，我认为 Sheets(n) 表达式实际上被解释为“第 n 个可见工作表”。因此，除非您编写一个循环测试每个工作表的可见属性，否则在代码中使用它会充满危险，除非工作簿受到保护，因此用户不能弄乱工作表的可见属性。太难...

我对这个困境的解决方案是：

使最后一张表可见（即使是临时的）
在那张纸之后复制。它必须有索引 Sheets.Count
如果需要，再次隐藏前最后一张表 - 它现在将具有索引 Sheets.Count-1
将新工作表移动到您真正想要的位置。

这是我的代码 - 现在似乎是防弹的......

Dim sh as worksheet
Dim last_is_visible as boolean

With ActiveWorkbook
    last_is_visible = .Sheets(.Sheets.Count).Visible
    .Sheets(Sheets.Count).Visible = True
    .Sheets("Template").Copy After:=.Sheets(Sheets.Count)
    Set sh=.Sheets(Sheets.Count)
    if not last_is_visible then .Sheets(Sheets.Count-1).Visible = False 
    sh.Move After:=.Sheets("OtherSheet")
End With

就我而言，我有这样的事情（H表示隐藏的表格）

1... 2... 3(H)... 4(H)... 5(H)... 6... 7... 8(H)... 9(H)

.Copy After:=.Sheets(2) 实际上在下一个 VISIBLE 工作表之前创建了一个新工作表 - 即，它成为新的索引 6。而不是索引 3，如您所料。

希望有帮助;-)

score 14 · Accepted Answer

我使用的另一个解决方案是将工作表复制到您知道其索引的地方，也就是首先。在那里，您可以轻松地引用它以获取所需的任何内容，然后您可以将其自由移动到您想要的位置。

像这样的东西：

Worksheets("Sheet1").Copy before:=Worksheets(1)
set newSheet = Worksheets(1)
newSheet.move After:=someSheet

score 6 · Accepted Answer

更新：

Dim ThisSheet As Worksheet
Dim NewSheet As Worksheet
Set ThisSheet = ActiveWorkbook.Sheets("Sheet1")
ThisSheet.Copy
Set NewSheet = Application.ActiveSheet

score 4 · Accepted Answer

更新了 Daniel Labelle 的建议：

要处理可能的隐藏工作表，请使源工作表可见，复制它，使用该ActiveSheet方法返回对新工作表的引用，并重置可见性设置：

Dim newSheet As Worksheet
With ActiveWorkbook.Worksheets("Sheet1")
    .Visible = xlSheetVisible
    .Copy after:=someSheet
    Set newSheet = ActiveSheet
    .Visible = xlSheetHidden ' or xlSheetVeryHidden
End With

score 3 · Accepted Answer

我意识到这篇文章已经有一年多了，但我来这里是为了寻找关于复制工作表和隐藏工作表导致的意外结果的相同问题的答案。以上都不是我想要的，主要是因为我的工作簿的结构。本质上它有大量的工作表，显示的内容是由用户选择特定功能驱动的，加上可见工作表的顺序对我来说很重要，所以我不想弄乱那些。所以我的最终解决方案是依赖 Excel 复制工作表的默认命名约定，并明确地按名称重命名新工作表。下面的代码示例（顺便说一句，我的工作簿有 42 张，只有 7 张是永久可见的，并且 after:=Sheets(Sheets.count)将我复制的工作表放在 42 张工作表的中间，具体取决于当时可见的工作表。

        Select Case DCSType
        Case "Radiology"
            'Copy the appropriate Template to a new sheet at the end
            TemplateRAD.Copy after:=Sheets(Sheets.count)
            wsToCopyName = TemplateRAD.Name & " (2)"
            'rename it as "Template"
            Sheets(wsToCopyName).Name = "Template"
            'Copy the appropriate val_Request to a new sheet at the end
            valRequestRad.Copy after:=Sheets(Sheets.count)
            'rename it as "val_Request"
            wsToCopyName = valRequestRad.Name & " (2)"
            Sheets(wsToCopyName).Name = "val_Request"
        Case "Pathology"
            'Copy the appropriate Template to a new sheet at the end
            TemplatePath.Copy after:=Sheets(Sheets.count)
            wsToCopyName = TemplatePath.Name & " (2)"
            'rename it as "Template"
            Sheets(wsToCopyName).Name = "Template"
            'Copy the appropriate val_Request to a new sheet at the end
            valRequestPath.Copy after:=Sheets(Sheets.count)
            wsToCopyName = valRequestPath.Name & " (2)"
            'rename it as "val_Request"
            Sheets(wsToCopyName).Name = "val_Request"
    End Select

无论如何，发布以防万一对其他人有用

score 3 · Accepted Answer

这个问题真的很老了，但由于不久前这里有一些活动，它仍然给了我 10 年后我需要的所有答案，我想分享我这样做的方式。

阅读此线程后，我发现 Tigregalis 的答案非常有趣，即使我更喜欢 Ama 的解决方案。但是它们都没有反映原始 Excel 行为，可以选择在之前/之后复制或复制到新工作簿。当我需要它时，我写下了我自己的函数，为了让它更接近 Excel 的函数，我让它能够处理表格，而不仅仅是工作表。

对于那些感兴趣的人，这是我的代码：

Function CopySheet(ByVal InitSh As Object, Optional ByVal BeforeSh As Object, Optional ByVal AfterSh As Object) As Object
'Excel doesn't provide any reliable way to get a pointer to a newly copied sheet. This function allows to make it
'Arguments: - InitSh : The sheet we want to copy
'           - BeforeSh : The sheet before the one we want the copy to be placed
'           - AfterSh : The sheet after the one we want the copy to be placed
'Return   : - Returns the newly copied sheet. If BeforeSh and AfterSh are not givent to the sub, the sheet is created in a new workbook. In the case both are given, BeforeSh is used
'             To beknown : if the InitSh is not visible, the new one won't be visible except if InitWks is the first of the workbook !

    Dim isBefore As Boolean
    Dim isAfter As Boolean
    Dim Wkb As Workbook
    
    'If there is before or after, we need to know the workbook where the new sheet is copied, if not we need to set up a new workbook
    If Not BeforeSh Is Nothing Then
        isBefore = True
        Set Wkb = BeforeSh.Parent
    ElseIf Not AfterSh Is Nothing Then
        isAfter = True
        Set Wkb = AfterSh.Parent
    Else
        Set Wkb = Application.Workbooks.Add(xlWBATWorksheet)
    End If

    'To be able to find the new worksheet, we need to make sure the first sheet of the destination workbook is visible and make the copy before it
    Dim FirstWksVisibility As XlSheetVisibility
    FirstWksVisibility = Wkb.Sheets(1).Visible
    Wkb.Sheets(1).Visible = xlSheetVisible

    InitSh.Copy before:=Wkb.Sheets(1)

    'Restore the initial visibility of the first worksheet of the workbook, that is now the sheet number 2 as we copied one in front of it
    Wkb.Sheets(2).Visible = FirstWksVisibility
    
    'Finaly, move the sheet accordingly to otpional arguments BeforeWks or AfterWks
    Dim TempSh As Object
    Set TempSh = Wkb.Sheets(1)
    If isBefore Then
        TempSh.Move before:=BeforeSh
    ElseIf isAfter Then
        TempSh.Move after:=AfterSh
    Else
        'If no optional arguments, we made a new workbook and we need to erase the blank worksheet that was created with it if the new sheet is visible (we cant if it's not visible)
        If TempSh.Visible = xlSheetVisible Then
            Dim Alert As Boolean
            Alert = Application.DisplayAlerts
            Application.DisplayAlerts = False
            Wkb.Sheets(2).Delete
            Application.DisplayAlerts = Alert
        End If
    End If
    
    Set CopySheet = TempSh
End Function

我尝试使用工作表和图表广泛地测试我的代码，我认为它可以达到它的设计目的。唯一需要注意的是，如果源文件不可见，则复制的工作表将不可见，除非源文件是工作簿的第一张工作表。

score 2 · Accepted Answer

这应该是对@TimWilliams 的回应，但这是我的第一篇文章，所以我无法发表评论。

这是@RBarryYoung 提到的与隐藏工作表相关的问题的一个示例。当您尝试将副本放在最后一张纸之后并且最后一张纸被隐藏时，会出现问题。似乎，如果最后一张表被隐藏，它总是保留最高索引，所以你需要类似的东西

Dim sht As Worksheet

With ActiveWorkbook
   .Sheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)
   Set sht = .Sheets(.Sheets.Count - 1)
End With

当您尝试在隐藏的第一张纸之前复制时，类似的情况。

score 2 · Accepted Answer

基于Trevor Norman 的方法，我开发了一个用于复制工作表并返回对新工作表的引用的函数。

如果不可见，则取消隐藏最后一张纸 (1)
在最后一张表 (1) 之后复制源表 (2)
设置对新工作表 (3) 的引用，即最后一张工作表 (1) 之后的工作表
如有必要，隐藏最后一张纸 (1)

代码：

Function CopySheet(ByRef sourceSheet As Worksheet, Optional ByRef destinationWorkbook As Workbook) As Worksheet

    Dim newSheet As Worksheet
    Dim lastSheet As Worksheet
    Dim lastIsVisible As XlSheetVisibility

    If destinationWorkbook Is Nothing Then Set destinationWorkbook = sourceSheet.Parent

    With destinationWorkbook
        Set lastSheet = .Worksheets(.Worksheets.Count)
    End With

    ' store visibility of last sheet
    lastIsVisible = lastSheet.Visible
    ' make the last sheet visible
    lastSheet.Visible = xlSheetVisible

    sourceSheet.Copy After:=lastSheet
    Set newSheet = lastSheet.Next

    ' restore visibility of last sheet
    lastSheet.Visible = lastIsVisible

    Set CopySheet = newSheet

End Function

这将始终在目标工作簿的末尾插入复制的工作表。

在此之后，您可以进行任何移动、重命名等。

用法：

Sub Sample()

    Dim newSheet As Worksheet

    Set newSheet = CopySheet(ThisWorkbook.Worksheets("Template"))

    Debug.Print newSheet.Name

    newSheet.Name = "Sample" ' rename new sheet
    newSheet.Move Before:=ThisWorkbook.Worksheets(1) ' move to beginning

    Debug.Print newSheet.Name

End Sub

或者，如果您希望行为/界面更类似于内置的 Copy 方法（即之前/之后），您可以使用：

Function CopySheetTo(ByRef sourceSheet As Worksheet, Optional ByRef beforeSheet As Worksheet, Optional ByRef afterSheet As Worksheet) As Worksheet

    Dim destinationWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim lastSheet As Worksheet
    Dim lastIsVisible As XlSheetVisibility

    If Not beforeSheet Is Nothing Then
        Set destinationWorkbook = beforeSheet.Parent
    ElseIf Not afterSheet Is Nothing Then
        Set destinationWorkbook = afterSheet.Parent
    Else
        Set destinationWorkbook = sourceSheet.Parent
    End If

    With destinationWorkbook
        Set lastSheet = .Worksheets(.Worksheets.Count)
    End With

    ' store visibility of last sheet
    lastIsVisible = lastSheet.Visible
    ' make the last sheet visible
    lastSheet.Visible = xlSheetVisible

    sourceSheet.Copy After:=lastSheet
    Set newSheet = lastSheet.Next

    ' restore visibility of last sheet
    lastSheet.Visible = lastIsVisible

    If Not beforeSheet Is Nothing Then
        newSheet.Move Before:=beforeSheet
    ElseIf Not afterSheet Is Nothing Then
        newSheet.Move After:=afterSheet
    Else
        newSheet.Move After:=sourceSheet
    End If

    Set CopySheetTo = newSheet

End Function

score 1 · Accepted Answer

隐藏工作表会导致新工作表索引在源工作表的任一侧不连续，这是正确的。我发现如果您之前复制，Rachel 的答案有效。但是，如果您在之后复制，则必须对其进行调整。

一旦模型可见并被复制，无论您在之前还是之后复制源，新的工作表对象都只是 ActiveSheet。

作为偏好，您可以替换：

Set newSheet = .Previous与设置newSheet = Application.ActiveSheet。

希望这对你们中的一些人有所帮助。

score 1 · Accepted Answer

正如这里已经提到的，将工作表复制/粘贴到最左边（索引 = 1），然后将其分配给一个变量，然后将其移动到您想要的位置。

Function CopyWorksheet(SourceWorksheet As Worksheet, AfterDestinationWorksheet As Worksheet) As Worksheet

    Dim DestinationWorkbook As Workbook
    Set DestinationWorkbook = AfterDestinationWorksheet.Parent

    Dim FirstSheetVisibility As XlSheetVisibility
    FirstSheetVisibility = DestinationWorkbook.Sheets(1).Visible

    DestinationWorkbook.Sheets(1).Visible = xlSheetVisible
    SourceWorksheet.Copy Before:=DestinationWorkbook.Sheets(1)
    DestinationWorkbook.Sheets(2).Visible = FirstSheetVisibility

    Dim NewWorksheet As Worksheet
    Set NewWorksheet = DestinationWorkbook.Sheets(1)

    NewWorksheet.Move After:=AfterDestinationWorksheet

    Set CopyWorksheet = NewWorksheet

End Function

score 1 · Accepted Answer

我有同样的要求，并在寻找答案时来到了这个线程。在检查各种选项时，发现访问新工作表的一种简单方法是使用 Excel 存储的引用链（示例如下）。似乎 Excel 在工作表引用中维护了一种链接列表。

'Example:
ActiveWorkbook.Sheets("Sheet1").Copy After:=someSheet
set newSheet = someSheet.Next

同样，对于在另一张纸“之前”插入的纸片......

ActiveWorkbook.Sheets("Sheet1").Copy Before:=someSheet
set newSheet = someSheet.Previous

即使源工作表被隐藏也可以工作。如果源工作表被隐藏，工作表被复制，但新工作表也保持隐藏！

score 0 · Accepted Answer

我遇到了与 OP 相同的问题，但添加了一些隐藏和非常隐藏的工作表。

使用类似 {set last_sheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)} 的方法查找最后一张工作表不起作用，因为 Excel 不计算隐藏的工作表，因此位置编号 {last_sheet.Index + 1} 太高并且犯了一个错误。

相反，我做了一个循环来找到位置：

Dim w as Workbook, s as Worksheet, template_sheet as worksheet, last_sheet as Worksheet, new_sheet as Worksheet
    
' find the position of the last sheet
  For Each s in w.Workbooks
    If s.Visible = xlSheetVisible then
      Set last_sheet = s
    End if
  Next
    
' make the sheet to be copied visible, copy it and hide it again
  w.Worksheets("template_sheet").Visible = xlHidden
  w.Worksheets("template_sheet").Copy After:=last_sheet
  w.Worksheets("template_sheet").Visible = xlVeryHidden
        
' reference the new sheet that was just added
  Set new_sheet = Worksheets(last_sheet.index + 1)

score 0 · Accepted Answer

多年来，我一直在尝试为 sheet.Copy 方法创建一个可靠的通用“包装器”函数，以便在多个项目中重复使用。

我在这里尝试了几种方法，我发现只有 Mark Moore 的答案是所有场景的可靠解决方案。即使用“模板（2）”名称来识别新工作表的那个。

就我而言，任何使用“ActiveSheet 方法”的解决方案都是无用的，因为在某些情况下，目标工作簿位于非活动或隐藏的工作簿中。

同样，我的一些工作簿在不同位置混合了隐藏的工作表和可见的工作表；开头，中间，结尾；因此，我发现使用 Before: 和 After: 选项的解决方案也不可靠，具体取决于可见和隐藏工作表的顺序，以及源工作表也被隐藏时的附加因素。

因此，经过多次重写，我最终得到了以下包装函数：

'***************************************************************************
'This is a wrapper for the worksheet.Copy method.
'
'Used to create a copy of the specified sheet, optionally set it's name, and return the new
' sheets object to the calling function.
'
'This routine is needed to predictably identify the new sheet that is added. This is because
' having Hidden sheets in a Workbook can produce unexpected results in the order of the sheets,
' eg when adding a hidden sheet after the last sheet, the new sheet doesn't always end up
' being the last sheet in the Worksheets collection.
'***************************************************************************
Function wsCopy(wsSource As Worksheet, wsAfter As Worksheet, Optional ByVal sNewSheetName As String) As Worksheet

    Dim Ws              As Worksheet

    wsSource.Copy After:=wsAfter
    Set Ws = wsAfter.Parent.Sheets(wsSource.Name & " (2)")

    'set ws Name if one supplied
    If sNewSheetName <> "" Then
        Ws.Name = sNewSheetName
    End If
    Set wsCopy = Ws
End Function

注意：如果源工作表的名称超过 27 个字符，即使此解决方案也会出现问题，因为最大工作表名称是 31，但这通常在我的控制之下。

score 0 · Accepted Answer

旧帖子，但不确定是否要取消隐藏工作表或为名称添加后缀。

这是我的方法：

Sub DuplicateSheet()
    Dim position As Integer
    Dim wbNewSheet As Worksheet
    position = GetFirstVisiblePostion

    ThisWorkbook.Worksheets("Original").Copy Before:=ThisWorkbook.Sheets(position)
    Set wbNewSheet = ThisWorkbook.Sheets(position)

    Debug.Print "Duplicated name:" & wbNewSheet.Name, "Duplicated position:" & wbNewSheet.Index

End Sub

Function GetFirstVisiblePostion() As Integer
    Dim wbSheet As Worksheet
    Dim position As Integer
    For Each wbSheet In ThisWorkbook.Sheets
        If wbSheet.Visible = xlSheetVisible Then
            position = wbSheet.Index
            Exit For
        End If
    Next
    GetFirstVisiblePostion = position
End Function

score 0 · Accepted Answer

想用以下代码分享我的简单解决方案

Sub copy_sheet(insheet As String, newsheet As String)
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets(newsheet).Delete
ThisWorkbook.Sheets(insheet).Copy before:=ThisWorkbook.Sheets(1)
For Each ws In ThisWorkbook.Worksheets
    If (InStr(ws.Name, insheet) > 0 And InStr(ws.Name, "(") > 0) Then
        ThisWorkbook.Sheets(ws.Name).Name = newsheet
        Exit For
    End If
Next
Application.DisplayAlerts = True
End Sub

每当您复制工作表时，生成的“复制”工作表总是具有原始工作表的名称和括号内的数字。只要您的原始工作表都不包含括号中的数字名称，这将在 100% 的时间内有效。

它复制工作表，然后遍历所有工作表名称，查找 1) 包含原始名称和 2) 有括号数字的工作表，然后重命名工作表

excel - 复制工作表并获取结果工作表对象？

16 回答 16

Related

Reference