求助：编写宏实现按条件将指定工作表数据转移至另一工作表

先帮你梳理下现有代码里的几个核心问题，再给你调整后的可用版本：

现有代码的问题 #

• 工作表源目标搞反了：你需要从Sheet1提取数据到Sheet2，但代码里把Source设成了Sheet2，Target设成了Sheet1，逻辑完全颠倒了。
• 固定单元格覆盖：你用Target.Range("C5").Value赋值，每次都会覆盖C5单元格，没有利用j变量动态切换行号，所以最终只会保留最后一个符合条件的值。
• 条件不完整：你的需求是同时满足「A列是Blue」且「对应B列是Apples」，但现有代码只判断了单一条件，而且循环的列（D列）和你描述的A列不匹配。

修正后的宏代码 #

Sub UpdateBlueApples()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    
    ' 正确设置源表和目标表：从Sheet1取数据，存到Sheet2
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")
    
    j = 1 ' 从目标表的第1行开始存放（可根据需求改成比如C5，就设j=5）
    
    ' 循环源表中A列的目标范围（这里假设是A35到A100，可根据实际调整）
    For Each c In Source.Range("A35:A100")
        ' 同时满足两个条件：A列是Blue，且同一行的B列是Apples
        If c.Value = "Blue" And c.Offset(0, 1).Value = "Apples" Then
            ' 将B列的数据写入目标表的C列，行号随j递增
            Target.Range("C" & j).Value = c.Offset(0, 1).Value
            j = j + 1 ' 准备下一行的写入位置
        End If
    Next c
End Sub

关键调整说明 #

1. 工作表映射：明确Source是数据来源Sheet1，Target是数据目标Sheet2，和你的需求匹配。
2. 动态行号：用"C" & j来生成动态的单元格地址，每次写入后j自增，避免覆盖之前的数据。
3. 完整条件判断：加入c.Offset(0,1).Value = "Apples"来验证同一行B列的值，确保只转移符合双重条件的数据。
4. 列范围适配：代码里循环的是A列（Source.Range("A35:A100")），如果你的实际数据列不是A列，比如是D列，把这里改成Source.Range("D35:D100")，同时c.Offset(0,1)要对应到你存Apples/Pears的列（比如D列的话，B列对应就是c.Offset(0,-2)，根据实际列偏移调整）。

运行宏前，记得确认：

• 工作表名称和代码里的一致（如果你的表名不是Sheet1/Sheet2，改成实际名称）
• 循环的单元格范围和你数据所在的范围匹配
• 目标列（代码里是C列）是你想存入数据的列

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