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

问题描述 投票：25回答：11

有没有简单/简短的方法来获取复制工作表时获得的新工作表的Excel.worksheet对象？

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

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

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

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

excel vba excel-vba copy-paste worksheet
11个回答
25
投票
Dim sht 

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

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

  1. 如果不可见，取消隐藏最后一张纸（1）
  2. 在最后一张纸（1）后复制源表（2）
  3. 设置对新工作表（3）的引用，即最后一个工作表（1）之后的工作表
  4. 如有必要，隐藏最后一张（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
0
投票

正如这里已经提到的，将工作表复制/粘贴到最左边（index = 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
14
投票

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

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

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

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

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

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，正如您所料。

希望有所帮助;-)

10
投票

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

像这样的东西：

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

更新：

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

我意识到这篇文章已经有一年多了，但是我来到这里寻找一个关于复制工作表和隐藏工作表引起的意外结果的相同问题的答案。由于我的工作簿结构，上述所有内容都不适合我想要的内容。 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

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

2
投票

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

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

Dim sht As Worksheet

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

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

2
投票

更新了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
1
投票

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

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

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

使用“Set newSheet = Application.ActiveSheet”设置“newSheet = .Previous”。

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

0
投票

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

我在这里尝试了几种方法，我发现只有Mark Moore的答案才能成为所有场景的可靠解决方案。即使用“Template（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，但这通常由我控制。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.