Thread: Macro for transposing multiple columns to rows

Hi nique... Welcome to the forum.

Click GO ADVANCED and use the paperclip icon to post up a desensitized copy of your workbook.

Make sure it has BEFORE and AFTER examples so we can see what you want.

Try this:

Option Explicit

Sub TransposeColumnDatasToRow()
Dim LR As Long, Rw As Long, LC As Long, Col As Long
Dim MyArr As Variant

Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
Rw = LR + 3
LC = Cells(1, Columns.Count).End(xlToLeft).Column

    For Col = 1 To LC
        MyArr = Application.WorksheetFunction _
            .Transpose(Range(Cells(1, Col), Cells(LR, Col)))
        Cells(Rw, (LR * Col) - (LR - 1)).Resize(, UBound(MyArr)).Value = MyArr
    Next Col

Application.ScreenUpdating = True
End Sub

Option Explicit         'turn on code checking, helps eliminate mistakes

Sub TransposeColumnDatasToRow()
Dim LR As Long          'used to store last row of data
Dim Rw As Long          'stores target row for transposed data
Dim LC As Long          'stores last column with data in it
Dim Col As Long         'the current column being transposed
Dim MyArr As Variant    'array to store column data in tranposed format

Application.ScreenUpdating = False                  'speed up macro, no screen flicker
LR = Range("A" & Rows.Count).End(xlUp).Row          'find last row of data
Rw = LR + 3                                         'set the target row
LC = Cells(1, Columns.Count).End(xlToLeft).Column   'find last column with data


    For Col = 1 To LC                               'loop columns from A to last column
      'tranpose col into array
        MyArr = Application.WorksheetFunction _
            .Transpose(Range(Cells(1, Col), Cells(LR, Col)))
      'paste array values into target row, the destination column
      'each time is found by multiplying last row by the current column num
      'and subtracting all but one from the last row count.
      'for instance if LR is 68 and we are in col 1 right now, then the math
      'is:  (68*1)-(68-1)=(68)-(67)=1, so the target column would be 1. Next col
      'would be (68*2)-(68-1)=(136)-(67)=69, so second target column is 69. etc.
      'Once target column is found on target row, we resize the target cells by
      'the number of values currently in the array.  Then we drop in the array.
        Cells(Rw, (LR * Col) - (LR - 1)).Resize(, UBound(MyArr)).Value = MyArr
    Next Col

Application.ScreenUpdating = True       'turn screenupdating back to normal, view results
End Sub

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread.