Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Transpose Rows Into Columns

Back to: Excel VBA . Got any Excel/VBA Questions? Free Excel Help

Transpose Single Column List Into X Columns



Sub TransposeRows()

Dim lRows As Long, lCol As Long

Dim rCol As Range

Dim lLoop As Long

Dim wsStart As Worksheet, wsTrans As Worksheet





    On Error Resume Next

    'Get single column range

    Set rCol = Application.InputBox(Prompt:="Select single column", _
                                    Title:="TRANSPOSE ROWS", Type:=8)

                                    

    'Cancelled or non valid range

    If rCol Is Nothing Then Exit Sub

    

    lRows = Application.InputBox(Prompt:="Transpose every x rows", _
                                        Title:="TRANSPOSE ROWS", Type:=2)

                                    

    'Cancelled

    If lRows = 0 Then Exit Sub

                                    

    'Make sure the transpositions will fit

    If lRows > ActiveSheet.Columns.Count Then

        MsgBox "Your 'transpose every x rows' exceeds the columns available"

        Exit Sub

    End If

    

    'Limit range to used cells

    lCol = rCol.Column

    Set rCol = Range(rCol(1, 1), Cells(Rows.Count, lCol).End(xlUp))

    

    'Set Worksheet variables

    Set wsStart = ActiveSheet

    Set wsTrans = Sheets.Add()

    wsStart.Select

    

    'Loop with step of x and transpose

    For lLoop = rCol(1, 1).Row To Cells(Rows.Count, lCol).End(xlUp).Row Step lRows

            Cells(lLoop, lCol).Resize(lRows, 1).Copy

            wsTrans.Cells(Rows.Count, "A").End(xlUp)(2, 1).PasteSpecial Transpose:=True

            Application.CutCopyMode = False

    Next lLoop

    

    On Error GoTo 0

End Sub

Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft