如何将一个ListObject设置为另一个ListObject的完全副本且不删除原表？

没问题，这种需求很常见——既要把一个ListObject的内容完整复制到另一个，又不能删除目标表（因为有公式依赖它的名称）。我给你一套可行的VBA方案，分步骤实现：

核心思路 #

我们的目标是保留tblPriorTable的表对象本身（名称、结构基础），只替换它的内容为源表的完全副本，包括数据、格式、公式等。具体步骤是：清空目标表数据→匹配列数（可选）→复制源表内容→粘贴到目标表。

完整VBA代码示例 #

Sub CopyListObjectPreserveReference()
    Dim srcTable As ListObject
    Dim destTable As ListObject
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    
    ' 替换成你的实际工作表和表名称
    Set wsSource = ThisWorkbook.Worksheets("SourceSheet") ' 源表所在工作表
    Set srcTable = wsSource.ListObjects("SourceTable")     ' 源ListObject名称
    
    Set wsDest = ThisWorkbook.Worksheets("DestSheet")     ' 目标表所在工作表
    Set destTable = wsDest.ListObjects("tblPriorTable")   ' 要保留的目标表
    
    ' 1. 清空目标表现有数据行（保留表头和表结构）
    On Error Resume Next ' 避免无数据行时报错
    destTable.DataBodyRange.Delete
    On Error GoTo 0
    
    ' 2. 可选：调整目标表列数与源表匹配（如果列数不同的话）
    ' 删除多余列
    Do While destTable.ListColumns.Count > srcTable.ListColumns.Count
        destTable.ListColumns(destTable.ListColumns.Count).Delete
    Loop
    ' 添加缺少的列
    Do While destTable.ListColumns.Count < srcTable.ListColumns.Count
        destTable.ListColumns.Add
    Loop
    
    ' 3. 复制源表的所有内容（表头+数据+格式+公式）
    srcTable.Range.Copy
    
    ' 4. 粘贴到目标表的起始位置
    destTable.HeaderRowRange.PasteSpecial Paste:=xlPasteAll ' 粘贴所有内容
    
    ' 清理剪贴板
    Application.CutCopyMode = False
    MsgBox "复制完成！目标表 tblPriorTable 已更新为源表的完全副本", vbInformation
End Sub

代码说明 #

• 保留目标表名称：全程没有删除或重建tblPriorTable，只是修改它的内容，所以依赖这个表名的公式完全不受影响。
• 清空数据行：用DataBodyRange.Delete只删除数据部分，表头和表结构保留，避免破坏表对象。
• 列数匹配（可选）：如果源表和目标表列数不同，这段代码会自动调整，确保粘贴时不会出错。如果你的两个表列数本来就一致，可以把这部分删掉。
• 完全复制：xlPasteAll会粘贴所有内容，包括单元格格式、数据、公式、条件格式等，和直接复制Range的效果一致。

特殊情况处理 #

如果你只想复制源表的数据行，保留目标表的表头，可以把第3、4步改成：

' 只复制源表的数据行
srcTable.DataBodyRange.Copy
' 粘贴到目标表表头下方的位置
destTable.HeaderRowRange.Offset(1, 0).PasteSpecial Paste:=xlPasteAll

这样操作后，tblPriorTable的结构和名称都不变，内容完全替换成了源表的副本，完美满足你的需求。

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