VBA新手咨询：多条件筛选下跨工作表逐行数据复制实现方法

• 变量声明规则不熟悉：Dim Today, EndDate as Date 写法下只有EndDate是Date类型，Today是默认的Variant类型，很容易出现日期匹配错误
• 冗余的界面操作：反复调用Activate、Select切表选单元格，不仅运行速度慢，还容易因为界面焦点跳转触发误操作，甚至覆盖参数值
• 粘贴逻辑错位：原代码把输出起始点设在了存储参数的K8单元格，运行过程中会直接把存放在K8的起始日期值覆盖，导致后续筛选逻辑失效
• 布尔值判断冗余：If z And x And c = True Then 写法完全没必要，直接判断三个布尔值本身即可，多写的等于True不仅冗余，还容易因为运算顺序出错
• 循环内重复声明变量：把布尔类型的条件判断变量写在循环体内部，无需每次循环都重复初始化声明

• 全程用对象引用操作工作表、单元格，完全跳过界面激活、选择的步骤，从根源上避免焦点跳转变量错位的问题
• 单独维护目标输出的行号指针：提前计算目标区域的起始写入行，每匹配到1条符合筛选条件的行，行号自动+1，比靠偏移找单元格的逻辑稳定10倍以上
• 用直接值赋值代替复制粘贴操作：逐列把源表的指定列值写到目标单元格，不占用系统剪贴板，运行速度比复制粘贴快几十倍，还不会带入多余的格式
• 把所有需要用到的参数、对象提前初始化，逻辑按「读参数→找数据范围→逐行校验条件→匹配就写入→收尾恢复设置」的顺序串起来，不会出现逻辑混乱

Option Explicit

Sub 筛选匹配并结构化输出()
    ' 关闭屏幕刷新提升运行速度
    Application.ScreenUpdating = False
    
    ' 定义所有工作表对象
    Dim paramSheet As Worksheet
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    ' 定义业务变量
    Dim startDate As Date, endDate As Date
    Dim matchName As String
    Dim lastSourceRow As Long, lastTargetRow As Long
    Dim writeStartRow As Long
    Dim i As Long, colIdx As Integer
    ' 定义需要从源表提取的列顺序，和原代码提取的列完全对齐
    Dim extractCols As Variant
    
    ' 绑定所有工作表对象
    Set paramSheet = ThisWorkbook.Worksheets("sheet1")
    Set sourceSheet = ThisWorkbook.Worksheets("sheet2")
    ' 目标输出表可根据实际需求调整，这里默认复用sheet1的非参数存储区域
    Set targetSheet = ThisWorkbook.Worksheets("sheet1")
    extractCols = Array("B", "F", "G", "H", "K", "D")
    
    ' 读取筛选判定参数
    startDate = paramSheet.Range("k8").Value
    endDate = paramSheet.Range("k9").Value
    matchName = "Condition 1"
    
    ' 获取源表最后一行数据的行号
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    ' 计算目标区域的起始写入行（默认从第2行开始写，第1行留作表头）
    lastTargetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    writeStartRow = lastTargetRow
    
    ' 逐行遍历源表数据
    For i = 2 To lastSourceRow
        ' 逐行校验三个筛选条件
        Dim cond1 As Boolean, cond2 As Boolean, cond3 As Boolean
        cond1 = sourceSheet.Cells(i, "G").Value >= startDate
        cond2 = sourceSheet.Cells(i, "H").Value <= endDate
        cond3 = sourceSheet.Cells(i, "F").Value = matchName
        
        ' 三个条件全部满足则逐列提取写入目标表
        If cond1 And cond2 And cond3 Then
            For colIdx = LBound(extractCols) To UBound(extractCols)
                ' 这里的列偏移可以根据实际输出位置调整，默认从目标表A列开始顺序写入
                targetSheet.Cells(lastTargetRow, colIdx + 1).Value = sourceSheet.Cells(i, extractCols(colIdx)).Value
            Next colIdx
            ' 写入完成后行号下移，准备写下一行
            lastTargetRow = lastTargetRow + 1
        End If
    Next i
    
    ' 恢复屏幕刷新设置
    Application.ScreenUpdating = True
    MsgBox "运行完成，共筛选写入" & lastTargetRow - writeStartRow & "条符合条件的数据"
End Sub

• 代码开头的Option Explicit一定要保留，强制要求所有变量提前声明，避免因为变量名打错、大小写不一致引发的莫名报错
• 输出区域一定要和参数存储区（K8、K9这类存筛选规则的单元格）隔开，不要把输出起点设在参数单元格上，否则运行几次就会把筛选参数覆盖掉
• 如果需要调整输出的列位置，只要修改代码里写入单元格的列号即可，比如要从K列开始输出，就把targetSheet.Cells(lastTargetRow, colIdx + 1)里的列号改成11 + colIdx（K列是第11列）
• 尽量减少复制粘贴的操作，日常小数据量的VBA脚本，直接值赋值是最稳定、最快的实现方式

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