Excel VBA批量复制选中工作表异常：仅重复复制首表问题排查

这个问题我之前也碰到过，根源在于你没有保存最初选中的工作表集合——每次循环里直接用ActiveWindow.SelectedSheets的话，第一次复制操作后，Excel会自动选中新生成的工作表，导致后续循环复制的已经不是你一开始选中的那些表了，甚至会出现只复制第一张的异常情况。

咱们来拆解一下你的代码问题：

• 第一次执行ActiveWindow.SelectedSheets.Copy时，确实会复制所有选中的工作表，但复制完成后，新创建的工作表会被自动选中。
• 从第二次循环开始，ActiveWindow.SelectedSheets指向的是刚复制出来的新表，而不是你最初选中的原始工作表。这就导致后续复制操作要么重复复制新表，要么因为选中状态异常，只复制其中第一张。

修正后的代码 #

要解决这个问题，我们只需要先把用户最初选中的工作表保存到一个变量里，之后循环的时候基于这个固定的集合来复制：

Public Sub DuplicateSheetMultipleTimes()
    Dim n As Integer
    Dim originalSelectedSheets As Sheets
    Dim numtimes As Integer
    
    ' 保存初始选中的工作表集合
    Set originalSelectedSheets = ActiveWindow.SelectedSheets
    
    On Error Resume Next
    n = InputBox("How many copies of the selected sheets do you want to make?")
    On Error GoTo 0 ' 恢复错误处理，避免后续代码忽略错误
    
    If n >= 1 Then
        For numtimes = 1 To n
            ' 使用保存的初始选中集合进行复制
            originalSelectedSheets.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Next numtimes
    End If
End Sub

关键改进点 #

• 保存初始选中集合：用Set originalSelectedSheets = ActiveWindow.SelectedSheets把用户一开始选中的工作表集合固定下来，避免后续操作改变选中对象影响复制逻辑。
• 恢复错误处理：去掉了On Error Resume Next的全局生效，只在InputBox时临时使用，防止后续代码的错误被忽略，方便排查问题。

这样修改后，不管循环多少次，每次都会复制你最初选中的所有工作表，不会出现只复制第一张的问题了。

内容的提问来源于stack exchange，提问作者Jay Hayers