VBA运行时错误-1004：应用程序定义或对象定义错误求助

错误原因 #

触发调试错误的核心原因有两个：

1. 空表/仅含表头的工作表导致Resize行数为0：当原工作表的UsedRange仅有1行（只有表头、无数据）时，Sheets(i).UsedRange.Rows.Count - 1结果为0，而Excel不允许Resize生成0行的区域，直接触发错误。
2. 变量类型与LastRow获取方式不准确：LastRow声明为Variant类型，且使用SpecialCells(xlCellTypeLastCell)获取最后一行，可能因单元格格式残留导致结果偏差。
3. 循环范围存在逻辑隐患：创建新表后，原循环的i范围可能意外遍历到新创建的空表，进一步触发错误。

修复后的完整代码 #

'声明变量
Dim LastRow As Long, ShtCnt As Integer
Dim ShtName As String
Dim NewSht As Worksheet
Dim ws As Worksheet

'获取用户输入的新表名称
ShtName:
ShtName = InputBox("输入要创建的工作表名称", "合并工作表", "主表")

'检查工作表是否已存在
For Each ws In ThisWorkbook.Sheets
    If ws.Name = ShtName Then
        MsgBox "该工作表已存在", vbExclamation, "合并工作表"
        GoTo ShtName
    End If
Next ws

'创建新工作表并调整位置
Set NewSht = ThisWorkbook.Sheets.Add
NewSht.Name = ShtName
NewSht.Move Before:=ThisWorkbook.Sheets(1)

'遍历所有原有工作表（跳过新创建的主表）
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> ShtName Then
        '第一个合并的表复制表头+全部数据
        If NewSht.Cells(1, 1) = "" Then
            ws.UsedRange.Copy NewSht.Cells(1, 1)
        Else
            '仅复制数据行（跳过表头），先判断是否有数据
            If ws.UsedRange.Rows.Count > 1 Then
                LastRow = NewSht.Cells(NewSht.Rows.Count, 1).End(xlUp).Row
                ws.UsedRange.Offset(1, 0).Resize(ws.UsedRange.Rows.Count - 1, ws.UsedRange.Columns.Count).Copy _
                    NewSht.Cells(LastRow + 1, 1)
            End If
        End If
    End If
Next ws

'提示合并完成
MsgBox "数据已成功合并至 " & ShtName, vbInformation, "合并工作表"

关键修复点说明 #

• 规避0行Resize错误：增加If ws.UsedRange.Rows.Count > 1 Then判断，仅当工作表存在数据行时才执行复制操作。
• 更可靠的LastRow获取：使用NewSht.Cells(NewSht.Rows.Count, 1).End(xlUp).Row替代SpecialCells(xlCellTypeLastCell)，确保准确获取实际最后一行数据的位置。
• 变量类型修正：将LastRow声明为Long类型，避免行数超过Integer上限（32767）导致的溢出问题。
• 遍历逻辑优化：使用For Each ws In Sheets遍历工作表，直接跳过新创建的主表，避免循环范围计算错误。

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