VBA循环复制问题：需按目标列非空条件批量复制对应单元格

你的代码存在几个关键问题导致复制结果不符合预期：

1. 循环起始逻辑偏差：你设置Conditionalcol=4，意味着从Datacopied表的C4开始判断非空，但如果你的C列数据从C3起始，循环的检查起点就错了。
2. 复制来源与目标的对应逻辑脱节：当前代码的复制来源是Dataneeded表B列第5行及以下，目标是Datacopied表B3偏移1行（即B4）及以下，和你“按C列非空行数对应复制B列数据”的需求不匹配。
3. 变量类型错误：Projectdowncell被定义为String，但它是用来做行偏移的数值类型，应该改为Integer。
4. 未限定工作表的单元格引用：a = Cells(Conditionalcol, 1)没有指定工作表，会默认使用当前激活的工作表，可能引发意外数据读取。

假设你的需求是：遍历Datacopied表的C列，只要C列单元格非空，就将Dataneeded表对应行的指定单元格复制到Datacopied表的B列同一行，修正后的代码如下：

Public Sub emptycell()
    Dim checkRow As Integer       ' 遍历Datacopied表C列的行号
    Dim sourceRow As Integer      ' Dataneeded表中要复制的行号
    Dim targetSheet As Worksheet
    Dim sourceSheet As Worksheet
    
    ' 初始化工作表对象，简化引用并避免拼写错误
    Set targetSheet = ThisWorkbook.Sheets("Datacopied")
    Set sourceSheet = ThisWorkbook.Sheets("Dataneeded")
    
    checkRow = 3                  ' 从C3开始检查（根据你的实际数据起始行调整）
    sourceRow = 1                 ' 从Dataneeded表的第1行开始复制（按需调整）
    
    ' 循环检查C列单元格，直到遇到空单元格停止
    Do While targetSheet.Cells(checkRow, 3) <> ""
        ' 复制Dataneeded表A列第sourceRow行到Datacopied表B列第checkRow行
        ' 若要复制其他列，修改Cells的第二个参数（1=A列，2=B列，以此类推）
        sourceSheet.Cells(sourceRow, 1).Copy Destination:=targetSheet.Cells(checkRow, 2)
        
        checkRow = checkRow + 1
        sourceRow = sourceRow + 1
    Loop
End Sub

• 用targetSheet和sourceSheet对象简化工作表引用，避免重复写表名和拼写错误。
• 明确循环起始行checkRow，可根据你实际的C列数据起始行调整。
• 修正变量类型，确保所有行号变量为Integer，避免类型转换错误。
• 让复制目标直接对应Datacopied表B列的非空行，和C列检查逻辑一一匹配，符合需求。
• 若需复制Dataneeded表的其他列，只需修改sourceSheet.Cells(sourceRow, 1)中的第二个参数即可。

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