求助：如何通过VBA按条件从Workbook1提取数据至Workbook2

嘿，我来帮你把这个数据提取的功能补全！从你给出的代码片段来看，已经搭好了基础框架，我来把缺失的逻辑补上，同时加入一些防错处理，让代码更健壮。

完整代码实现 #

Sub Button1_Click()
    Dim iLast As Long
    Dim i As Long, j As Long
    Dim targetLastRow As Long, sourceLastRow As Long
    Dim sourceLastCol As Long
    Dim source As Worksheet
    Dim target As Worksheet
    Dim xRow As Integer ' 对应你原本定义的起始行变量
    
    ' 防错：先检查两个工作簿是否已打开
    On Error Resume Next
    Set source = Workbooks("workbook1").Sheets(1)
    Set target = Workbooks("workbook2").Sheets("Sheet1")
    On Error GoTo 0
    
    If source Is Nothing Or target Is Nothing Then
        MsgBox "请确保Workbook1和Workbook2都已打开！", vbExclamation
        Exit Sub
    End If
    
    ' 动态获取数据源的最后行和最后列（适配数据量变化，不用硬编码）
    sourceLastRow = source.Cells(source.Rows.Count, "A").End(xlUp).Row
    sourceLastCol = source.Cells(1, source.Columns.Count).End(xlToLeft).Column
    
    ' 目标表的起始写入行（你设置的xRow=10）
    targetLastRow = 10
    
    ' 遍历数据源的每一行（假设表头在第1行，从第2行开始遍历数据）
    For i = 2 To sourceLastRow
        ' --------------------------
        ' 这里替换成你的**特定条件**
        ' 示例：如果第3列（C列）的值等于"合格"，就提取该行
        If source.Cells(i, 3).Value = "合格" Then
        ' --------------------------
            ' 复制整行数据到目标表
            source.Range(source.Cells(i, 1), source.Cells(i, sourceLastCol)).Copy _
                target.Cells(targetLastRow, 1)
            
            ' 目标行号自增，准备写入下一条数据
            targetLastRow = targetLastRow + 1
        End If
    Next i
    
    ' 完成提示
    MsgBox "数据提取完成！共提取" & targetLastRow - 10 & "条符合条件的数据。", vbInformation
End Sub

关键部分说明 #

• 防错处理：先检查两个工作簿是否存在，避免因工作簿未打开导致的运行时错误
• 动态范围获取：用End(xlUp)和End(xlToLeft)自动识别数据源的边界，不用手动修改范围，适配数据量变化
• 条件自定义：代码里的示例条件是「第3列等于"合格"」，你需要把这部分替换成自己的实际需求（比如某列大于指定数值、单元格包含特定文本等）
• 写入位置调整：如果需要改变目标表的起始写入行，直接修改targetLastRow的初始值即可

额外优化建议 #

• 如果只需要提取特定列而非整行，可以把复制范围改成指定列，比如source.Range("A" & i & ",C" & i & ",E" & i).Copy
• 大数量数据提取时，可在代码开头加Application.ScreenUpdating = False，结尾加Application.ScreenUpdating = True，提升运行速度

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