Excel VBA：依据估算表L列数值复制A列内容到发票表仅首条生效求助

原有代码问题说明 #

• 复制源固定写死为Sheets("Estimate").Range("A5")，没有随着遍历的行动态变化
• 粘贴目标固定写死为Sheets("Invoice").Range("C22")，所有符合条件的内容都会覆盖粘贴到同一个单元格，所以只能看到第一条结果
• 依赖ActiveCell、Select这类选中操作，不仅执行效率低，还容易因为工作表焦点变化出现逻辑错误
• 外层Do Until逻辑冗余且判断条件无意义，WorksheetFunction.CountA(rng_dest.Rows(i)) = 100完全不符合业务需求

修正后的可运行代码 #

Sub CopyToInvoice()
    Dim wsEst As Worksheet, wsInv As Worksheet
    Dim estRow As Long, invRow As Long
    Dim maxEstRow As Long
    
    ' 绑定工作表对象，避免后续反复写表名出错
    Set wsEst = ThisWorkbook.Sheets("Estimate")
    Set wsInv = ThisWorkbook.Sheets("Invoice")
    
    ' 初始化发票表粘贴起始行：C22
    invRow = 22
    ' 估算表遍历起始行：L列从第5行开始检查
    estRow = 5
    ' 取估算表L列最后一个有内容的行号，避免无效遍历
    maxEstRow = wsEst.Cells(wsEst.Rows.Count, "L").End(xlUp).Row
    
    Application.ScreenUpdating = False
    ' 先清空发票表C22:C36区域原有内容，避免旧数据干扰
    wsInv.Range("C22:C36").ClearContents
    
    ' 遍历停止条件：估算表遍历完所有有内容的行，或发票表目标区域填充满
    Do While estRow <= maxEstRow And invRow <= 36
        ' 先判断L列是数值再做比较，避免文本内容报错
        If IsNumeric(wsEst.Cells(estRow, "L").Value) Then
            If wsEst.Cells(estRow, "L").Value > 0 Then
                ' 复制当前行A列内容到发票表对应位置
                wsInv.Cells(invRow, "C").Value = wsEst.Cells(estRow, "A").Value
                ' 粘贴位置下移一行
                invRow = invRow + 1
            End If
        End If
        ' 估算表遍历行下移
        estRow = estRow + 1
    Loop
    
    Application.ScreenUpdating = True
End Sub

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