Transpose from columns only found items

[arnelgp]

you may also try this VBA:

Public Sub subTranspose()


    Const SHT As String = "Table 1"
    
    Const FIRST_COLUMN As String = "A"
    Const FIRST_ROW  As Integer = 11
    
    Const LAST_COLUMN As String = "AV"
    Const LAST_ROW As Integer = 55


    Const RESULT_COLUMN As String = "AX"
    Const RESULT_ROW As Long = 3
    
    Dim j As Long, k As Long
    Dim c As String
    Dim rstl_col As String
    Dim rslt_row As Long
    Dim value As Long
    
    Dim cond As Object
    Set cond = CreateObject("scripting.dictionary")
    ' add the conditions here
    cond(1) = 1
    cond(20) = 1
    cond(27) = 1
    cond(41) = 1
    cond(60) = 1
    cond(77) = 1
    


    rslt_row = RESULT_ROW
    
    With Sheets(SHT)
        
        For k = ColumnLetterToNumber(FIRST_COLUMN) To ColumnLetterToNumber(LAST_COLUMN) Step 1
            c = ColumnNumberToLetter(k)
            rstl_col = RESULT_COLUMN
            For j = FIRST_ROW To LAST_ROW Step 1
                value = Val(.Range(c & j) & "")
                If cond.exists(value) Then
                    .Range(rstl_col & rslt_row) = value
                    rstl_col = ColumnNumberToLetter(ColumnLetterToNumber(rstl_col) + 1)
                End If
            Next
            rslt_row = rslt_row + 1
        Next
        
    End With
        
        
End Sub


Public Function ColumnLetterToNumber(ByVal col As String) As Long
ColumnLetterToNumber = Range(col & "1").Column
End Function


Public Function ColumnNumberToLetter(ByVal col As Long) As String
ColumnNumberToLetter = Replace$(Replace$(Cells(1, col).Address, "1", ""), "$", "")
End Function