VBA 将工作表复制到工作簿末尾（带有隐藏工作表）答案

【问题标题】：VBA Copy Sheet to End of Workbook (with Hidden Worksheets)VBA 将工作表复制到工作簿末尾（带有隐藏工作表）
【发布时间】：2012-08-12 23:56:19
【问题描述】：

我想复制一张工作表并将其添加到所有当前工作表的末尾（无论这些工作表是否隐藏）。

Sheets(1).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = "copied sheet!"

这很好用，除了当有隐藏工作表时，新工作表只插入到最后一个可见工作表之后，所以name 命令重命名了错误的工作表。

我尝试了以下变体来获取对新复制的WorkSheet 的引用，但没有一个是成功和/或有效的代码。

Dim test As Worksheet
Set test = Sheets(1).Copy(After:=Sheets(Sheets.Count))
test.Name = "copied sheet!"

【问题讨论】：

标签： vba excel

【解决方案1】：

试试这个

Sub Sample()
    Dim test As Worksheet
    Sheets(1).Copy After:=Sheets(Sheets.Count)
    Set test = ActiveSheet
    test.Name = "copied sheet!"
End Sub

回想起来，更好的方法是

Set test = Sheets(Sheets.Count)

正如下面的 cmets 中正确提到的，在复制和重命名工作表时需要考虑很多事情。建议也检查其他答案。

【讨论】：

哇，我不敢相信我没有意识到新复制的工作表在被复制后立即被激活.. :) 编辑 - 它并不漂亮，但它可以满足我的需要。跨度>
不，如果您使用 Application.ScreenUpdating = False 来隐藏闪烁，这将不起作用。
如果原始工作表被隐藏并且您复制该工作表，则新工作表也被隐藏。因此，您的代码无法正常工作。
以防万一：如果源表是.Visible = xlSheetVeryHidden，则不能复制！如果源工作表是.Visible = xlSheetHidden，则可以复制，但新工作表不是活动表。
cmets 是对的：此解决方案在规定的情况下失败：它们应作为警告包含在解决方案中而 @dra_red 代码看起来很有希望作为通用解决方案

【解决方案2】：

在复制之前使源工作表可见。然后复制工作表，使副本也保持可见。然后副本将成为活动工作表。如果需要，请再次隐藏源工作表。

【讨论】：

我确认，这是“更清洁”的方式。它也适用于 ScreenUpdating=False。

【解决方案3】：

我在将工作表复制到另一个工作簿时遇到了类似的问题。我更喜欢避免使用“activesheet”，因为它在过去给我带来了问题。因此，我编写了一个函数来根据我的需要执行此操作。我在这里为那些像我一样通过谷歌到达的人添加它：

这里的主要问题是，将可见工作表复制到最后一个索引位置会导致 Excel 将工作表重新定位到可见工作表的末尾。因此，将工作表复制到最后一张可见工作表之后的位置可以解决此问题。即使您正在复制隐藏的工作表。

Function Copy_WS_to_NewWB(WB As Workbook, WS As Worksheet) As Worksheet
    'Creates a copy of the specified worksheet in the specified workbook
    '   Accomodates the fact that there may be hidden sheets in the workbook
    
    Dim WSInd As Integer: WSInd = 1
    Dim CWS As Worksheet
    
    'Determine the index of the last visible worksheet
    For Each CWS In WB.Worksheets
        If CWS.Visible Then If CWS.Index > WSInd Then WSInd = CWS.Index
    Next CWS
    
    WS.Copy after:=WB.Worksheets(WSInd)
    Set Copy_WS_to_NewWB = WB.Worksheets(WSInd + 1)

End Function

要对原始问题（即在同一个工作簿中）使用此功能，可以使用类似...

Set test = Copy_WS_to_NewWB(Workbooks(1), Workbooks(1).Worksheets(1))
test.name = "test sheet name"

编辑 2020 年 4 月 11 日来自 –user3598756 添加对上述代码的轻微重构

Function CopySheetToWorkBook(targetWb As Workbook, shToBeCopied As Worksheet, copiedSh As Worksheet) As Boolean
    'Creates a copy of the specified worksheet in the specified workbook
    '   Accomodates the fact that there may be hidden sheets in the workbook

    Dim lastVisibleShIndex As Long
    Dim iSh As Long

    On Error GoTo SafeExit
    
    With targetWb
        'Determine the index of the last visible worksheet
        For iSh = .Sheets.Count To 1 Step -1
            If .Sheets(iSh).Visible Then
                lastVisibleShIndex = iSh
                Exit For
            End If
        Next
    
        shToBeCopied.Copy after:=.Sheets(lastVisibleShIndex)
        Set copiedSh = .Sheets(lastVisibleShIndex + 1)
    End With
    
    CopySheetToWorkBook = True
    Exit Function
    
SafeExit:
    
End Function

除了使用不同的（更具描述性的？）变量名外，重构主要处理：

将 Function 类型转换为 `Boolean 同时在函数参数列表中包含返回（复制）的工作表这个，让调用 Sub 处理可能的错误，比如

 Dim WB as Workbook: Set WB = ThisWorkbook ' as an example
 Dim sh as Worksheet: Set sh = ActiveSheet ' as an example
 Dim copiedSh as Worksheet
 If CopySheetToWorkBook(WB, sh, copiedSh) Then
     ' go on with your copiedSh sheet
 Else
     Msgbox "Error while trying to copy '" & sh.Name & "'" & vbcrlf & err.Description
 End If

让 For - Next 循环从最后一个工作表索引向后步进并在第一个可见工作表出现时退出，因为我们在“最后一个”可见工作表之后

【讨论】：

嗨@dra_red：虽然解决方案很好。这应该是公认的，因为它确实克服了在 Siddharth Rout 的一个 cmets 中检测到的所有可能的问题我希望你不介意我编辑了你的解决方案添加了一个可能的重构：当然你可以编辑它们和/或编辑您的解决方案以及我的一些建议

【解决方案4】：

如果你使用基于@Siddharth Rout 的代码的以下代码，你重命名刚刚复制的工作表，不管它是否被激活。

Sub Sample()

    ThisWorkbook.Sheets(1).Copy After:=Sheets(Sheets.Count)
    ThisWorkbook.Sheets(Sheets.Count).Name = "copied sheet!"

End Sub

【讨论】：

当工作表队列末尾有隐藏工作表时，您提供的代码会重命名最后一个隐藏工作表，而不是从复制操作创建的新工作表。
当然，您应该始终在需要时取消隐藏/隐藏工作表。所以首先取消隐藏your code再次隐藏。
不，您必须取消隐藏目标工作簿中的每个工作表，这是不合理的。

【解决方案5】：

将此代码添加到开头：

    Application.ScreenUpdating = False
     With ThisWorkbook
      Dim ws As Worksheet
       For Each ws In Worksheets: ws.Visible = True: Next ws
     End With

将此代码添加到末尾：

    With ThisWorkbook
     Dim ws As Worksheet
      For Each ws In Worksheets: ws.Visible = False: Next ws
    End With
     Application.ScreenUpdating = True

如果您希望超过第一张工作表处于活动状态且可见，请在最后调整代码。如：

     Dim ws As Worksheet
      For Each ws In Worksheets
       If ws.Name = "_DataRecords" Then

         Else: ws.Visible = False
       End If
      Next ws

为确保新工作表是重命名的工作表，请调整您的代码，如下所示：

     Sheets(Me.cmbxSheetCopy.value).Copy After:=Sheets(Sheets.Count)
     Sheets(Me.cmbxSheetCopy.value & " (2)").Select
     Sheets(Me.cmbxSheetCopy.value & " (2)").Name = txtbxNewSheetName.value

此代码来自我的用户表单，它允许我将具有我想要的格式和公式的特定工作表（从下拉框中选择）复制到新工作表，然后使用用户输入重命名新工作表。请注意，每次复制工作表时，都会自动为其指定旧工作表名称，并指定“(2)”。示例“OldSheet”在复制之后和重命名之前变为“OldSheet (2)”。所以在重命名之前必须选择带有程序命名的复制表。

【讨论】：

这会破坏用户想要隐藏或可见的任何工作表。

【解决方案6】：

当您要复制名为“mySheet”的工作表并使用 .Copy After:= 时，Excel 首先将复制的工作表命名为完全相同，并简单地添加“(2)”，使其最终名称为“mySheet (2) ”。

隐藏与否，无所谓。它使用 2 行代码，将复制的工作表添加到工作簿的末尾！！！

示例：

Sheets("mySheet").Copy After:=Sheets(ThisWorkbook.Sheets.count)
Sheets("mySheet (2)").name = "TheNameYouWant"

简单不！

【讨论】：

【解决方案7】：

答案：我找到了这个并想与你分享。

Sub Copier4()
   Dim x As Integer

   For x = 1 To ActiveWorkbook.Sheets.Count
      'Loop through each of the sheets in the workbook
      'by using x as the sheet index number.
      ActiveWorkbook.Sheets(x).Copy _
         After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
         'Puts all copies after the last existing sheet.
   Next
End Sub

但问题是，我们可以用它和下面的代码来重命名工作表吗？如果可以，我们该怎么做？

Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Summary").Range("A10")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
End Sub

【讨论】：