Convert Multiple Columns to Rows depending on an Input Value

**prkhan56** · 07-06-2014, 04:12 AM

Hello All,
I have lot of data in Excel 2010 which I wish to bring in Columns using a Macro depending on the input value which the macro should prompt me.
For Eg:

A1 B1 C1 D1 E1 F1 G1 H1 I1 J1
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9 10

If I select data from A1 and J1 (in practical it will be more Columns) the Macro should prompt me how many Columns would be the output on Master Sheet.
If the input is 2 then it should create an output Sheet ‘Master’ and should show the following result
A1 B1
1 2
1 2
1 2
1 2
1 2
3 4
3 4
3 4
3 4
3 4
5 6
5 6
5 6
5 6
5 6
.. ..
.. ..
It after selection I run the macro and input 3 then the output should go in three columns (A1,B1,C1) one below other. If 4 is Input then 4 Columns (A1,B1,C1,D1) will come below each other so on and so forth.
I hope this gives the idea.
Any help would be greatly appreciated.
TIA
Rashid Khan

**PCI** · 07-06-2014, 05:47 AM

Try next code

Option Explicit
Sub Treat()
Dim Msg
Dim NbCols  As Long
Dim Input_Value
Dim WkRg  As Range, F  As Range
Dim Lastrow As Long, NbRows As Long
Dim I As Long, J As Long
    NbCols = Selection.Columns.Count
    On Error GoTo EndStat
    If (NbCols > 1) Then
        Msg = InputBox("There is " & NbCols & " columns, what is your choice")     '  To  read USER  info
        Msg = Msg * 1             '  TI  CHANGE  TO  NUMBER
        Sheets("Master").Cells.ClearContents
        Set WkRg = Selection.Columns.Cells.EntireColumn
        Lastrow = WkRg.Cells(Rows.Count, 1).End(xlUp).Row
        Set WkRg = WkRg.Rows(1 & ":" & Lastrow)
        NbRows = NbCols * Lastrow / Msg: NbRows = NbRows + 1
        ReDim Tbl(1 To Msg, 1 To NbRows)
        I = 1: J = 1
        For Each F In WkRg.Cells
            Sheets("Master").Cells(I, J) = F.Value
            J = J + 1
            If (J > Msg) Then
                I = I + 1: J = 1
            End If
        Next F
    End If
EndStat:
End Sub

**prkhan56** · 07-06-2014, 03:32 PM

Hello PCI,
Thanks for the code.
But it does not give the desired result as per my original post.
Code provided by Jindon suits my requirement.
Thanks for your time.
Rashid Khan

**jindon** · 07-06-2014, 06:54 AM

Try

Sub test()
    Dim myStep As Long, i As Long, LastR As Range
    Sheets("master").Cells.Clear
    myStep = Application.InputBox("Enter # of columns", Type:=1)
    With Intersect(Selection.CurrentRegion, Selection.EntireColumn)
        For i = 1 To .Columns.Count Step myStep
            If i = 1 Then
                Set LastR = Sheets("master").Cells(1)
            Else
                Set LastR = Sheets("master").Range("a" & Rows.Count).End(xlUp)(2)
            End If
            .Columns(i).Resize(, myStep).Copy LastR
        Next
    End With
End Sub

**prkhan56** · 07-06-2014, 03:29 PM

Hello Jindon,
Thanks for the prompt reply. Your code works great. I need to get some modifications please.

Sorry I missed the Heading Part in my original post. First Row within the Selection would be Headings. It copies the Headings too.
See Master Sheet in the Sample file attached.
I have mentioned the results required.

Also would it be possible to modify the code to work on all the sheets in the Workbook except the Master sheet and append the data of each sheet below in the Master Sheet.

Thanks once again.

You are a great help.
Rashid Khan

**jindon** · 07-06-2014, 07:48 PM

Not really sure if this is what you wanted.

Sub test()
    Dim myStep As Long, i As Long, LastR As Range
    Dim rng As String, flg As Boolean, ws As Worksheet
    Sheets("master").Cells.Clear
    myStep = Application.InputBox("Enter # of columns", Type:=1)
    rng = Selection.EntireColumn.Address
    For Each ws In Worksheets
        If ws.Name <> Sheets("master").Name Then
            With Intersect(ws.Range(rng), ws.Range(rng).CurrentRegion)
                If .Count > 1 Then
                    For i = 1 To .Columns.Count Step myStep
                        Set LastR = Sheets("master").Cells(1)
                        If Not IsEmpty(LastR) Then
                            Set LastR = Sheets("master").Range("a" & Rows.Count).End(xlUp)(2)
                            flg = True
                        End If
                        .Columns(i).Offset(IIf(flg, 1, 0)) _
                        .Resize(.Rows.Count - IIf(flg, 1, 0), myStep).Copy LastR
                    Next
                End If
            End With
        End If
    Next
End Sub

**prkhan56** · 07-07-2014, 04:01 PM

Works like a charm!
Thanks a lot for your time and help
Really appreciated
Rashid Khan

Convert Multiple Columns to Rows depending on an Input Value

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Convert Multiple Columns to Rows depending on an Input Value

Re: Convert Multiple Columns to Rows depending on an Input Value

Re: Convert Multiple Columns to Rows depending on an Input Value

Re: Convert Multiple Columns to Rows depending on an Input Value

Re: Convert Multiple Columns to Rows depending on an Input Value

Re: Convert Multiple Columns to Rows depending on an Input Value

Re: Convert Multiple Columns to Rows depending on an Input Value

Thread Information

Users Browsing this Thread

Similar Threads

Convert multiple columns to rows

Combining multiple rows from 2 columns into sorted columns depending on 1st columns value

Convert rows with multiple unique columns into individual rows for pivot table management

[SOLVED] Finding multiple matches of a single input across multiple rows and columns

To convert data in multiple sets of columns to multiple rows

Bookmarks

Bookmarks

Posting Permissions