Swapping (Rearranging) Multiple Columns of Data

[Rick Rothstein]

Sub RearrangeColumns()
Rows(1).Insert
Range("A1:AJ1").Value = Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36)
Range("A:AJ").Sort key1:=Range("A1"), order1:=xlAscending, Orientation:=xlSortRows
Rows(1).Delete
End Sub

I used as many lines of code as I did because I wanted to make the code friendly to users by allowing them to specify the columns using letter references instead of making them count the columns in order to figure out their column numbers. However, going with your specified array, and if we don't count Dim statements as "live" code, I can do it in two lines of code...

Sub RearrangeColumns()
  Dim NewOrder As Variant
  NewOrder = Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36)
  Range("A1").Resize(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, UBound(NewOrder) + 1) = Application.Index(Cells, Evaluate("ROW(1:" & Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row & ")"), NewOrder)
End Sub

and if we do not mind counting the number of array elements manually, that can be reduced to a single line of code (albeit a very long one)...

Sub RearrangeColumns()
  Range("A1").Resize(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, 36) = Application.Index(Cells, Evaluate("ROW(1:" & Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row & ")"), Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36))
End Sub