基于Sheet1列I的条件，用VBA将指定列数据复制到Sheet2对应列

嘿，作为VBA新手碰到这类数据迁移需求太常见啦！我给你写了一段针对性的代码，完全贴合你的需求，还加了详细注释，方便你跟着理解：

Sub CopyYRowsToSheet2()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    Dim i As Long
    
    ' 定义源工作表和目标工作表
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    
    ' 找到Sheet1的最后一行（避免遍历空行）
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "I").End(xlUp).Row
    
    ' 遍历Sheet1的I列，从第1行到最后一行
    For i = 1 To lastRowSource
        ' 判断当前行I列是否为"Y"
        If wsSource.Cells(i, "I").Value = "Y" Then
            ' 找到Sheet2的首个可用行（A列最后一行的下一行）
            lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
            ' 如果Sheet2还是空的，默认从第1行开始，否则从下一行开始
            If lastRowTarget = 1 And wsTarget.Cells(1, "A").Value = "" Then
                lastRowTarget = 1
            Else
                lastRowTarget = lastRowTarget + 1
            End If
            
            ' 按照指定映射关系赋值
            wsTarget.Cells(lastRowTarget, "A").Value = wsSource.Cells(i, "E").Value ' E→A
            wsTarget.Cells(lastRowTarget, "B").Value = wsSource.Cells(i, "D").Value ' D→B
            wsTarget.Cells(lastRowTarget, "C").Value = wsSource.Cells(i, "B").Value ' B→C
        End If
    Next i
    
    MsgBox "数据复制完成！", vbInformation
End Sub

• 直接赋值代替复制粘贴：代码里用.Value直接传递数据，比用Copy/Paste效率更高，还能避免剪贴板干扰
• 动态找最后一行：不管Sheet1有多少数据，都会自动找到实际有内容的最后一行，不会浪费时间遍历空行
• 兼容Sheet2为空的情况：如果Sheet2一开始没有数据，会自动从第1行开始写入，不会跳过首行
• 明确的工作表引用：用ThisWorkbook确保操作的是当前打开的工作簿，避免误操作其他文件

你只需要打开VBA编辑器（按Alt+F11），插入一个新模块，把这段代码粘贴进去，运行就能完成需求啦！

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