VBA实现跨工作表转置粘贴公式为文本并跳过空白循环问题

针对你的需求，以下代码可以实现跳过空白单元格、将公式生成的数据以文本格式转置为连续表头的功能，同时避免#REF错误：

Sub Transpose_Filtered_Text()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceRange As Range
    Dim sourceValues As Variant
    Dim filteredValues As Variant
    Dim i As Long, j As Long
    
    ' 定义源工作表和目标工作表
    Set wsSource = ThisWorkbook.Worksheets("BUTTON")
    Set wsTarget = ThisWorkbook.Worksheets("Output")
    Set sourceRange = wsSource.Range("F13:F42")
    
    ' 将源区域的公式计算结果读取到数组
    sourceValues = sourceRange.Value
    
    ' 统计非空单元格数量
    j = 0
    For i = 1 To UBound(sourceValues, 1)
        If sourceValues(i, 1) <> "" Then
            j = j + 1
        End If
    Next i
    
    ' 初始化过滤后的数组
    ReDim filteredValues(1 To 1, 1 To j)
    j = 0
    
    ' 填充过滤后的数组（跳过空白）
    For i = 1 To UBound(sourceValues, 1)
        If sourceValues(i, 1) <> "" Then
            j = j + 1
            filteredValues(1, j) = sourceValues(i, 1)
        End If
    Next i
    
    ' 清空目标区域并设置文本格式，写入转置后的非空值
    With wsTarget.Range("A1").Resize(1, j)
        .ClearContents
        .NumberFormat = "@" ' 设置为文本格式
        .Value = filteredValues
    End With
    
    ' 释放对象
    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set sourceRange = Nothing
End Sub

关键说明： #

• 规避#REF错误：直接读取源区域的公式计算结果值而非复制公式，彻底切断引用关联，避免因源数据变动或无效引用触发错误。
• 过滤空白单元格：通过数组遍历筛选非空内容，最终生成连续排列的表头，无需后续调整位置。
• 强制文本格式：先将目标单元格格式设为@（文本格式）再写入值，确保所有内容以文本形式保存，避免数值、日期等格式自动转换。
• 运行效率优化：使用数组操作替代逐个单元格循环，大幅提升代码执行速度，尤其适配批量数据处理场景。

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