VBA function 将公式中的特殊内容粘贴为单独工作表中的文本

Question

我现在已经粘贴并转置了，但现在的问题是如何将其创建为一个循环，以便在并排粘贴时跳过空白？

我正在尝试转置从一张表中的公式创建的数据并将其作为列标题粘贴到另一张表中。 我还希望它忽略空白单元格，以便所有内容都排成一行。 每次我运行它时，它都会给我 #REF 并且似乎无法弄清楚如何避免它。

Sub Transpose_Example()
    Worksheets("BUTTON").Range("F13:F42").Copy
    Worksheets("Output").Range("A1").PasteSpecial Transpose:=True

End Sub

我试图将数据行转置为单独工作表中的列标题。 正在复制的数据是一个公式，我试图将其粘贴为文本但无法成功。

Answer 1

粘贴值并使用循环转置

Sub CreateHeaders()

    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Sheets("BUTTON")
    Dim srg As Range ': Set srg = sws.Range("F13:F42")
    ' Instead of the static range, make the single-column range dynamic
    ' by referencing the range from 'F13' to the bottom-most non-empty cell:
    Set srg = sws.Range("F13", sws.Cells(sws.Rows.Count, "F").End(xlUp))
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Sheets("Output")
    Dim dCell As Range: Set dCell = dws.Range("A1") ' first destination cell

    ' Copy 
    
    Dim sCell As Range
    
    For Each sCell In srg.Cells
        If Len(CStr(sCell.Value)) > 0 Then ' is not blank
            dCell.Value = sCell.Value ' copy value
            Set dCell = dCell.Offset(, 1) ' next destination cell (to the right)
        End If
    Next sCell

    ' Inform.
    MsgBox "Headers created.", vbInformation
    
End Sub