however you run the macro, it does not destroy the order.
    Dim rngRegion As Range
    Dim col As Range
    Dim totalRows As Long, n As Long
    Dim output As String
    Dim arr() As Variant
    Dim itm() As Variant
    Dim var As String
    Dim i As Long, j As Long, lastColumn
    
    lastColumn = GetLastUsedColumn()
    ' Define the CurrentRegion based on the active cell
    Set rngRegion = Range(Cells(1, 1), Cells(1, lastColumn))
    'find the last row
    For Each col In rngRegion.Columns
        n = ActiveSheet.Cells(ActiveSheet.Rows.Count, col.Column).End(xlUp).Row
        If n > totalRows Then
            totalRows = n
        End If
    Next
    Set rngRegion = Range(Cells(1, 1), Cells(totalRows, lastColumn))
    ReDim itm(totalRows - 1)
    ' Loop through each column in the CurrentRegion
    For Each col In rngRegion.Columns
        'initial all elements in itm array
        For i = LBound(itm) To UBound(itm)
            itm(i) = ""
        Next
        arr = Range(Cells(1, col.Column), Cells(totalRows, col.Column))
        j = UBound(itm)
        For i = UBound(arr) To LBound(arr) Step -1
            If Len(arr(i, 1) & "") <> 0 Then
                itm(j) = arr(i, 1)
                j = j - 1
            End If
        Next
        For i = 0 To UBound(itm)
            Cells(i + 1, col.Column) = itm(i)
        Next
    Next col
End Sub


Function GetLastUsedColumn(Optional ws As Worksheet) As Long
    If ws Is Nothing Then Set ws = ActiveSheet


    Dim lastCol As Range
    Set lastCol = ws.Cells.Find(What:="*", _
                                 After:=ws.Cells(1, 1), _
                                 LookIn:=xlFormulas, _
                                 LookAt:=xlPart, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious)


    If Not lastCol Is Nothing Then
        GetLastUsedColumn = lastCol.Column
    Else
        GetLastUsedColumn = 0 ' No data found
    End If
End Function