VBA循环单元格按条件复制：无法生成空白单元格问题排查

核心问题分析 #

你的代码存在以下关键问题，导致无法正确生成空白单元格：

1. 语法错误：缺少End If语句
   第一个If myvalue < ...条件块没有对应的End If，导致VBA解析代码时逻辑混乱，后续代码无法按预期执行。

2. 工作表引用遗漏
   代码中("Mike Filter").Select缺少Sheets前缀，会触发编译错误，无法正确切换到目标工作表。

3. Lastrow计算不可靠
   使用Range("A" & StartRow).End(xlDown).Row获取最后一行时，若A列中间存在空白行，会提前终止遍历，导致部分数据未被处理。

4. 空白单元格范围不完整
   当前仅将B&i设为空，但你的需求是复制A-E到B-F，对应不满足条件时应该清空整个B-F行，而不只是单个单元格。

修正后的代码 #

Sub Mike_Copy_cell()
    Dim i As Long
    Dim myvalue As Variant
    Dim Lastrow As Long
    Const StartRow As Byte = 2
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    
    ' 定义工作表对象，避免使用Select提升稳定性
    Set sourceWs = ThisWorkbook.Sheets("Mike Filter")
    Set targetWs = ThisWorkbook.Sheets("Automate Report")
    
    ' 可靠获取A列最后一行数据行号
    Lastrow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
    
    For i = StartRow To Lastrow
        myvalue = sourceWs.Range("H" & i).Value
        ' 获取目标工作表A列的日期值
        Dim targetDate As Variant
        targetDate = targetWs.Range("A" & i).Value
        
        ' 条件判断：先处理小于的情况，再处理大于的情况
        If myvalue < targetDate Then
            ' 清空目标工作表B到F列的对应行
            targetWs.Range("B" & i, "F" & i).ClearContents
        ElseIf myvalue > targetDate Then
            ' 复制源工作表A-E行到目标工作表B-F行
            sourceWs.Range("A" & i, "E" & i).Copy targetWs.Range("B" & i)
        End If
    Next i
End Sub

关键优化点说明 #

• 移除Select操作：直接通过工作表对象引用单元格，避免因工作表切换导致的错误，提升代码稳定性。
• 修复语法结构：补充End If并使用ElseIf整理条件分支，确保逻辑清晰。
• 完整清空目标区域：不满足条件时清空整个B-F行，符合需求中"生成空白单元格"的预期。
• 可靠获取最后一行：使用Cells(Rows.Count, "A").End(xlUp).Row，无论A列是否有空白行，都能准确获取最后数据行。
• 可选同月判断优化：如果需求是严格匹配同月（含同年），可将条件替换为：

  If Month(myvalue) <> Month(targetDate) Or Year(myvalue) <> Year(targetDate) Then
      targetWs.Range("B" & i, "F" & i).ClearContents
  Else
      sourceWs.Range("A" & i, "E" & i).Copy targetWs.Range("B" & i)
  End If
  

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