VBA删除重复值后复制工作簿行到新Excel时出现下标越界错误问询

• 工作表名称不匹配：有两种触发场景，一是当前运行代码的工作簿（MyBook）中不存在名为Excel的工作表；二是新建工作簿的默认工作表名称不是Sheet1（比如中文版Excel默认新建工作表名为工作表1，不同语言环境默认名称存在差异），引用不存在的工作表会直接触发下标越界。
• xls格式行数限制溢出：你保存新文件用的xlNormal对应xls格式，该格式最大仅支持65536行，代码中硬编码的C1:P1000000范围远超过xls的最大行数限制，写入时会触发下标越界。
• 潜在诱因：删除重复值的代码未明确指定工作表父对象，默认取当前活动工作表，如果活动工作表不是目标Excel表，会导致后续复制的范围不符合预期，极端情况也会触发越界。

修改逻辑为动态获取实际使用的单元格范围，用工作表索引代替固定名称避免语言适配问题，适配xls格式的行数限制，修改后的完整代码如下：

Dim rg As Range
Dim MyBook As Workbook, newBook As Workbook
Dim FileNm As String
Dim lastRow As Long

Set MyBook = ThisWorkbook

' 明确指定操作Excel工作表，避免活动工作表错乱
With MyBook.Sheets("Excel")
    Set rg = .Range("F2").CurrentRegion
    rg.RemoveDuplicates Columns:=1, Header:=xlYes
    ' 动态获取C列到P列的实际最后一行
    lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
End With

FileNm = ThisWorkbook.Path & "\" & "TEST-BOOK.xls"
Set newBook = Workbooks.Add

With newBook
    ' 用Sheets(1)取第一个工作表，避免不同语言环境默认名称不同的问题
    ' 只复制实际有数据的范围，不要硬编码百万行
    MyBook.Sheets("Excel").Range("C1:P" & lastRow).Copy .Sheets(1).Range("A1")

    'Save new wb with XLS extension
    .SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=False

    .Close Savechanges:=False
End With

如果你的工作簿中确实没有名为Excel的工作表，将代码中所有Sheets("Excel")修改为你实际的工作表名称即可。

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