如何用Excel VBA宏复制Sheet2指定范围非空单元格值到Sheet3

完整可直接运行代码 #

Sub CopyNonEmptyValuesFromSheet2ToSheet3()
    Dim sourceRange As Range
    Dim sourceArr As Variant
    Dim resultArr As Variant
    Dim i As Long, j As Long, k As Long
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 定义源数据范围为Sheet2的A2:Q3500
    Set sourceRange = Sheet2.Range("A2:Q3500")
    ' 将源范围数据读入数组，大幅提升遍历效率
    sourceArr = sourceRange.Value
    ' 预定义结果数组，最大容量为源范围总单元格数
    ReDim resultArr(1 To sourceRange.Cells.Count, 1 To 1)
    
    k = 1
    ' 先行后列遍历所有单元格，筛选非空值
    For i = 1 To UBound(sourceArr, 1)
        For j = 1 To UBound(sourceArr, 2)
            ' 仅保留实际非空的单元格内容
            If Not IsEmpty(sourceArr(i, j)) Then
                resultArr(k, 1) = sourceArr(i, j)
                k = k + 1
            End If
        Next j
    Next i
    
    ' 清空Sheet3 A列从A2开始的原有数据，不需要可删除该行
    Sheet3.Range("A2", Sheet3.Cells(Rows.Count, "A").End(xlUp)).ClearContents
    
    ' 将筛选后的结果写入Sheet3，从A2开始排列
    If k > 1 Then
        Sheet3.Range("A2").Resize(k - 1, 1).Value = resultArr
    End If
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

代码说明 #

• 仅读取单元格的原生值，不会携带任何格式、公式、批注、条件格式等附加内容，完全保留原有文本/数字的精确值
• 默认遍历顺序为先行后列：先读取A2到Q2的所有非空值，再读取A3到Q3，以此类推，所有结果依次排列在Sheet3的A列
• 如果你需要按先列后行的顺序排列，只需要交换两层循环的顺序即可
• 如果你的工作表使用自定义显示名称，只需要将代码中的Sheet2/Sheet3替换为Sheets("你的工作表名称")
• 如果需要过滤公式返回的空文本""，可以将判断条件修改为If CStr(sourceArr(i, j)) <> "" Then

使用步骤 #

• 打开目标Excel文件，按Alt + F11唤起VBA编辑器
• 在左侧工程资源管理器中右键点击当前工作簿，选择「插入」-「模块」
• 将上述代码完整粘贴到弹出的模块编辑窗口中
• 按F5直接运行，也可以将宏绑定到工作表按钮方便后续调用

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