Question

是否有任何简单/简短方式来获取复制工作表时获得的新工作表的Excel.worksheet对象？

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

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

set newSheet = ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet    <-- doesn't work

所以，我写了大约25行代码来获取对象（在复制之前列出所有工作表，列出所有工作表之后，找出哪一个只在最后一个列表中。在VBA中都非常冗长），但是我我正在寻找更优雅，更短的解决方案。

Answer 1

Dim sht 

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

Answer 2

我相信我终于把这个问题钉在了一起 - 这也让我疯了！如果MS制作Copy会返回一个工作表对象，就像添加方法一样......

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

我解决这个难题的方法是：

使最后一张纸可见（即使是临时的）
复制该表后。它必须有索引Sheets.Count
如果需要，再次隐藏前一张最后一张 - 它现在会有 index 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：=。表（2）实际上是在下一个之前创建一个新表可见表 - 即，它成为新的索引6.不在索引3，正如您所料。

希望有所帮助;-)

Answer 3

我使用的另一个解决方案是将工作表复制到您知道其索引的位置，即第一个。在那里，您可以轻松地根据需要随意引用它，之后您可以将其自由移动到您想要的位置。

这样的事情：

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

Answer 4

更新：

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

Answer 5

我发现这篇文章已经有一年多了，但是我来到这里寻找有关复制工作表和隐藏工作表引起的意外结果的相同问题的答案。由于我的工作簿结构，上述所有内容都不适合我想要的内容。 Essentailly它有非常多的工作表，显示的内容是由用户选择特定功能驱动的，加上可见工作表的顺序是importnat给我，所以我不想搞砸那些。所以我的最终解决方案是依靠复制工作表的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

无论如何，张贴以防万一对其他人有用

Answer 6

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

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

这样的东西

Dim sht As Worksheet

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

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

Answer 7

更新了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

Answer 8

这个问题真的很老，但由于不久前这里有一些活动，它仍然给了我 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

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

Answer 9

隐藏的工作表是正确的，导致新的工作表索引在源工作表的任何一侧都是非顺序的。我发现Rachel的回答如果您以前复制过的话会有效。但是，如果您在之后复制，则必须对其进行调整。

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

作为首选项，您可以替换：

＆＃34;设置newSheet = .Previous＆＃34;使用＆＃34;设置newSheet = Application.ActiveSheet＆＃34;。

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

Answer 10

我一直在尝试创建一个可靠的通用＆＃34;包装＆＃34; sheet.Copy方法的功能，可以在多个项目中重复使用多年。

我已经在这里尝试了几种方法，而且我发现Mark Moore的答案只是在所有方案中成为可靠的解决方案。即使用＆＃34;模板（2）＆＃34;用于标识新工作表的名称。

就我而言，使用＆＃34; ActiveSheet方法＆＃34;没有用，因为在某些情况下，目标工作簿是在非活动或隐藏的工作簿中。

同样，我的一些工作簿中隐藏的纸张与不同位置的可见纸张混合在一起;在开始，在中间，在结尾;因此我发现使用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，但这通常由我控制。

Answer 11

基于Trevor Norman's method，我开发了一种复制工作表并返回对新工作表的引用的功能。

取消隐藏最后一张（1）（如果看不到）
复制最后一张（1）后的源表（2）
设置对新工作表（3）的引用，即最后一个工作表（1）之后的工作表
如有必要，隐藏最后一张（1）

代码：

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

    Dim newSheet As Worksheet, lastSheet As Worksheet
    Dim lastIsVisible As Boolean

    If destinationWorkbook Is Nothing Then Set destinationWorkbook = sourceSheet.Parent

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

    lastIsVisible = lastSheet.Visible
    lastSheet.Visible = True

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

    If Not lastIsVisible Then lastSheet.Visible = False

    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 CopySheet2(ByRef sourceSheet As Worksheet, Optional ByRef beforeSheet As Worksheet, Optional ByRef afterSheet As Worksheet) As Worksheet

    Dim destinationWorkbook As Workbook
    Dim newSheet As Worksheet, lastSheet As Worksheet
    Dim lastIsVisible As Boolean

    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

    lastIsVisible = lastSheet.Visible
    lastSheet.Visible = True

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

    If Not lastIsVisible Then lastSheet.Visible = False

    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 CopySheet2 = newSheet

End Function

Answer 12

正如这里已经提到的，将工作表复制/粘贴到最左侧（索引= 1），然后将其分配给变量，然后将其移动到所需位置。粘贴工作表Before意味着您无需验证和隐藏任何工作表。

我现在无法测试，但是我不明白为什么它不起作用。：）

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

    SourceWorksheet.Copy Before:= AfterDestinationWorksheet.Parent.Sheets(1)

    Dim NewWorksheet as Worksheet
    Set NewWorksheet = AfterDestinationWorksheet.Parent.Sheets(1)

    NewWorksheet.Move After:= AfterDestinationWorksheet 

    Return NewWorksheet

End Function

Answer 13

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

这是我的方法：

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

Answer 14

想与下面的代码分享我的简单解决方案

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）带有方括号的数字，然后重命名工作表

Answer 15

我遇到了与 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)

复制表格并获得结果表格对象？

15 个答案: