Make One Column Transpose

PHOTO EMBED

Wed Sep 08 2021 06:07:26 GMT+0000 (UTC)

Saved by @Darkleech #vba

Sub MakeOneColumn_Transpose()


    Dim vaCells As Variant
    Dim vOutput() As Variant
    Dim i As Long, j As Long
    Dim lRow As Long

    If TypeName(Selection) = "Range" Then
        If Selection.Count > 1 Then
            If Selection.Count <= Selection.Parent.Rows.Count Then
                vaCells = Selection.Value

                ReDim vOutput(1 To UBound(vaCells, 1) * UBound(vaCells, 2), 1 To 1)

                For j = LBound(vaCells, 2) To UBound(vaCells, 2)
                    For i = LBound(vaCells, 1) To UBound(vaCells, 1)
                        If Len(vaCells(i, j)) > 0 Then
                            lRow = lRow + 1
                            vOutput(lRow, 1) = vaCells(i, j)
                        End If
                    Next i
                Next j

                Selection.ClearContents
                Selection.Cells(1).Resize(lRow).Value = vOutput
            End If
        End If
    End If

End Sub
content_copyCOPY