Excel VBA：如何基于指定区域非空单元格计数结果复制数据？

针对你需要的统计Sheet1指定行非空单元格数量，再批量复制对应行数据到Sheet2的需求，我整理了一份完整的VBA代码，同时优化了原计数逻辑的鲁棒性：

Sub CopyDataBasedOnCount()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim currentRow As Long
    Dim targetRow As Long
    Dim nonEmptyCount As Long
    
    ' 初始化工作表引用，方便后续维护
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
    
    currentRow = 2 ' 从Sheet1的第2行开始处理
    targetRow = 2 ' 从Sheet2的第2行开始粘贴
    
    ' 循环处理，直到Sheet1当前行的A/B列都为空（可根据你的空行定义调整）
    Do While wsSource.Cells(currentRow, "A").Value <> "" Or wsSource.Cells(currentRow, "B").Value <> ""
        ' 处理区域无常量单元格时的报错情况
        On Error Resume Next
        ' 统计当前行C到P列的非空常量单元格数量（手动输入的内容）
        nonEmptyCount = wsSource.Range(wsSource.Cells(currentRow, "C"), wsSource.Cells(currentRow, "P")).SpecialCells(xlCellTypeConstants).Count
        On Error GoTo 0
        
        ' 如果没有找到常量非空单元格，改用CountA统计所有非空（包括公式返回值）
        If nonEmptyCount = 0 Then
            nonEmptyCount = Application.WorksheetFunction.CountA(wsSource.Range(wsSource.Cells(currentRow, "C"), wsSource.Cells(currentRow, "P")))
        End If
        
        ' 只有当计数大于0时才执行复制
        If nonEmptyCount > 0 Then
            ' 复制当前行A/B列数据
            wsSource.Range(wsSource.Cells(currentRow, "A"), wsSource.Cells(currentRow, "B")).Copy
            ' 批量粘贴到Sheet2的对应区域，避免循环粘贴提升效率
            wsTarget.Range(wsTarget.Cells(targetRow, "A"), wsTarget.Cells(targetRow + nonEmptyCount - 1, "B")).PasteSpecial Paste:=xlPasteValues
            ' 更新Sheet2的下一个粘贴起始行
            targetRow = targetRow + nonEmptyCount
        End If
        
        ' 移动到Sheet1的下一行
        currentRow = currentRow + 1
    Loop
    
    ' 清除剪贴板状态，避免Excel提示剪贴板内容
    Application.CutCopyMode = False
    MsgBox "数据复制任务完成！", vbInformation
End Sub

关键逻辑说明 #

• 空行判断：循环条件判断当前行的A或B列是否有内容，确保不会因为其中一列空就提前停止（如果你的空行定义是A和B列都为空，把Or改成And即可）。
• 非空计数优化：
  你原来的SpecialCells(xlCellTypeConstants)只能统计手动输入的常量值，如果单元格是公式返回的非空结果，不会被统计。我加入了错误处理和CountA的备选方案，你可以根据实际数据类型选择保留哪一种计数方式：
  • 只需要统计手动输入的内容：删除If nonEmptyCount = 0 Then这段代码
  • 需要统计所有非空（包括公式）：直接把原计数代码替换成CountA即可
• 高效批量粘贴：一次性计算出Sheet2的目标粘贴范围，批量粘贴值，比逐行循环粘贴效率高很多，尤其是处理大量数据时。
• 工作表引用：用变量指代工作表，后续如果需要修改工作表名称，只需要修改Set语句的部分，不用到处找代码里的工作表名。

注意事项 #

• 如果Sheet2的A2:B2区域已有数据，代码会直接覆盖，运行前请确保目标区域为空，或者把targetRow的初始值改成wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1，这样会自动从Sheet2的最后一行开始粘贴。
• 测试时建议先处理少量行，确认逻辑符合预期后再处理完整数据。

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