VBA代码未逐单元格执行逻辑求助：使用For Each与If判断

原代码问题 #

• 错误遍历J8:J22的单个单元格，只要遇到第一个空单元格就直接覆盖整个J8:J22区域，完全违背“逐列检查整列目标区域”的需求。
• 逻辑混乱：没有判断整列（8-22行）是否为空，而是通过单个单元格状态决定粘贴位置，导致误覆盖数据。

修正后的代码 #

Sub IMS1CopyToNextColumn()
    Application.ScreenUpdating = False
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim targetCol As Integer
    Dim checkRange As Range
    
    Set copySheet = Worksheets("SEEBREZ IMS.1")
    Set pasteSheet = Worksheets("IMS.1")
    
    ' 从J列（第10列）开始逐列检查
    targetCol = 10
    
    Do
        ' 定义当前列的8-22行检查区域
        Set checkRange = pasteSheet.Range(pasteSheet.Cells(8, targetCol), pasteSheet.Cells(22, targetCol))
        
        ' 判断该区域是否无任何非空值
        If WorksheetFunction.CountA(checkRange) = 0 Then
            ' 复制并粘贴数值到目标区域
            copySheet.Range("G8:G22").Copy
            checkRange.PasteSpecial xlPasteValues
            Exit Do ' 找到目标列后终止循环
        Else
            targetCol = targetCol + 1 ' 当前列有数据，切换到右侧下一列
        End If
    Loop
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

修正说明 #

• 从J列（第10列）起始，逐列验证8-22行区域是否完全为空（CountA函数返回0代表区域无数据）
• 找到第一个符合条件的空列后，直接将数据粘贴到该列的对应行，避免覆盖已有数据
• 移除了错误的单元格遍历逻辑，改用逐列判断的方式，完全匹配需求逻辑

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