Excel VBA筛选Sheet1的table1并复制指定列至Sheet2的table2实现动态更新

Option Explicit

Sub UpdateTable()
    Dim srcTable As ListObject, tgtTable As ListObject
    Dim srcRng As Range, col As Variant
    Dim insertRow As Long
    
    '关闭屏幕更新提升运行效率，避免界面闪屏
    Application.ScreenUpdating = False
    
    '绑定源表（Sheet1的总库存表）和目标表（Sheet2的食品分类表）
    Set srcTable = Sheet1.ListObjects("table1")
    Set tgtTable = Sheet2.ListObjects("table2")
    
    '清空目标表原有全部数据行
    If Not tgtTable.DataBodyRange Is Nothing Then
        tgtTable.DataBodyRange.Delete
    End If
    
    '源表按第三列筛选值为FOOD的行
    srcTable.Range.AutoFilter Field:=3, Criteria1:="FOOD"
    
    '判断是否存在符合筛选条件的可见数据行
    On Error Resume Next
    Set srcRng = srcTable.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not srcRng Is Nothing Then
        '计算目标表的插入起始行位置，适配空表/已有数据两种场景
        insertRow = IIf(tgtTable.InsertRowRange Is Nothing, tgtTable.ListRows.Add.Range.Row, tgtTable.InsertRowRange.Row)
        '逐列复制对应可见数据到目标表同名列
        For Each col In Array("Item", "Quantity", "Cost")
            srcTable.ListColumns(col).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=tgtTable.ListColumns(col).Range.Cells(insertRow, 1)
        Next col
    End If
    
    '取消源表筛选，恢复原始显示状态
    srcTable.AutoFilter.ShowAllData
    
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

• 统一了表对象的变量引用，修正了原代码中表名前后不一致、变量未定义的报错问题
• 优化了目标表旧数据清理逻辑：直接删除所有数据行比清空内容再删空行效率更高，不会残留空行
• 筛选后仅复制可见行的指定列数据，避免误复制不符合筛选条件的隐藏行
• 适配了目标表为空/已有数据两种场景的行插入逻辑，粘贴时自动扩展表格，不会出现覆盖表头或粘贴失败的问题

要实现Sheet1内容变动时Sheet2自动更新，需要添加工作表变更触发事件：

1. 按Alt+F11打开VBA编辑器
2. 在左侧工程资源管理器窗口双击Sheet1对象
3. 将以下代码粘贴到右侧的代码编辑窗口中：

Private Sub Worksheet_Change(ByVal Target As Range)
    '仅当修改的单元格属于总库存表范围时才触发更新
    If Not Intersect(Target, Me.ListObjects("table1").Range) Is Nothing Then
        Call UpdateTable
    End If
End Sub

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