简体   繁体   中英

VBA function to paste special from formula as text in separate sheet

I've got the paste and transpose down now, but now the question is how to I create this to be a loop so that it skips blanks when it pastes them side by side?

I'm trying to transpose data created from a formula in one sheet and paste it in another sheet as column headers. I am also wanting it to ignore blank cells so everything is lined up next to each other. Every time I run this, it gives me #REF and cannot seem to figure out how to avoid it.

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

End Sub

I tried to transpose rows of data as column headers in a separate sheet. The data being copied is a formula and I'm trying to paste it as text but cannot succeed in doing so.

Paste Values and Transpose Using a Loop

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM