Excel VBA如何复制动态表格、粘贴命名并解决下标越界问题

你的代码下标越界问题来自三处逻辑错误：

• 变量类型不匹配：你把cellRef定义为String字符串类型，却用Set关键字给它赋值单元格对象，Set仅能给对象类型变量赋值，字符串类型无法承载Range对象，这行本身就会抛出类型不匹配错误
• 表格引用逻辑错误：ActiveSheet.ListObjects("ActiveCell")的作用是在工作表的表格集合里查找名称为ActiveCell的表格，VBA不会自动将这个字符串识别为当前选中的单元格，工作表中不存在这个名称的表时自然触发下标越界
• 冗余的Select操作：全程通过选中单元格再操作的逻辑，很容易因为焦点变化导致引用位置偏差，完全没有必要

Sub ProcessDynamicTable()
    Dim ws As Worksheet
    Dim sourceTbl As ListObject
    Dim newTbl As ListObject
    Dim pasteStart As Range
    
    ' 绑定当前操作的工作表和源表格
    Set ws = ActiveSheet
    Set sourceTbl = ws.ListObjects("Table3")
    
    ' 定位粘贴起始位置：D列最后一个非空单元格向下偏移2行，和你原有定位逻辑一致
    Set pasteStart = ws.Cells(ws.Rows.Count, "D").End(xlUp).Offset(2, 0)
    
    ' 复制全表并粘贴
    sourceTbl.Range.Copy
    pasteStart.PasteSpecial xlPasteAll
    
    ' 绑定刚粘贴生成的新表（工作表中最新新增的表格就是最后一个ListObject），直接重命名
    Set newTbl = ws.ListObjects(ws.ListObjects.Count)
    newTbl.Name = "Table4"
    
    ' 清除新表数据区内容（自动排除表头）
    newTbl.DataBodyRange.ClearContents
    ' 将数据区格式从百分比改为常规数字格式
    newTbl.DataBodyRange.NumberFormat = "General"
    
    ' 清空剪贴板释放内存
    Application.CutCopyMode = False
End Sub

• 全程用对象绑定的方式操作单元格和表格，不需要使用Select、Selection、ActiveCell这类不稳定的引用，适配动态表格行列数自动变化的场景
• 新表定位逻辑不需要依赖选中位置，粘贴完成后直接取工作表表格集合的最后一个元素，就是刚粘贴生成的新表，不会出现找不到表的问题
• 用ListObject自带的DataBodyRange属性直接获取表格除表头外的所有数据区域，不需要手动计算行列号，后续如果要调整数据区格式、写入内容直接调用这个属性即可
• 如果运行时提示“表名已存在”，说明当前工作表里已经有叫Table4的表格，要么提前删除旧表，要么修改新表的命名规则即可

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