Excel VBA按列条件复制行时首列空无法复制如何解决

问题原因 #

原代码定位粘贴位置的逻辑存在缺陷：Sheet3.Range("A1").End(xlDown).Offset(1, 0)是从A1向下遍历，遇到第一个空白单元格就会停止定位，若已经粘贴的行A列为空，该方法会直接跳转至工作表底部，导致后续符合条件的行无法正确粘贴。

修改后完整代码 #

Sub ClearandCopyActiveFeedback()
    Sheet3.Range("A3:Z2000").ClearContents
    
    Dim StatusCol As Range
    Dim Status As Range
    Dim PasteCell As Range
    
    Set StatusCol = Sheet2.Range("B3:B2000")
    
    For Each Status In StatusCol
        ' 改为从A列底部向上查找最后一行，无视列内空白单元格
        Set PasteCell = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Status = "Active" Then Status.EntireRow.Copy PasteCell
    Next Status
End Sub

修改说明 #

替换了粘贴位置定位逻辑，采用VBA通用的「从工作表最后一行向上查找」的方式定位最后一个有内容的单元格，无论A列是否存在空白，都能精准找到下一行的粘贴位置，符合筛选复制要求。

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