Macro move next column to next row? [Closed]

Report
Posts
3
Registration date
Friday April 29, 2016
Status
Member
Last seen
May 2, 2016
-
Posts
1292
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
May 7, 2021
-
Dear All,
introducing my name is John and im new here.
Ive data like below


A B C D
1 John Willy Diana Chan Yu
2 male male Female Male
3 married single Single Single
4 Ohio Texas Las Vegas New York
5 yes NA Yes No


and i want to move next column to next row such as below


A B C D
1 John
2 male
3 married
4 Ohio
5 yes
6 Willy
7 male
8 single
9 Texas
10 NA
11 Diana
12 Female
13 Singe
14 Las Vegas
15 Yes
16 Chan Yu
17 Male
18 Single
19 New York
20 No


thank you very much for ur help

5 replies

Posts
1292
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
May 7, 2021
230
Hello Corescript,

I have below, a couple of slightly different codes that could do the task for you:-

Sub DoStuff()

   Dim Rng As Range
   
On Error Resume Next
Set Rng = Application.InputBox(Prompt:="Select range to be moved.", Title:="Select Ranges", Type:=8)

   If Not Rng Is Nothing Then
   Rng.Copy Sheet1.Range("A" & Rows.Count).End(3)(2)
   'Rng.Delete
   End If
   
End Sub


or

Sub DoStuff2()

Selection.Copy Sheet1.Range("A" & Rows.Count).End(3)(2)
'Selection.Delete

End Sub


The first code above uses an Input Box in which you place the range that you wish to transpose and then click on OK in the Input Box to execute the code.

With the second code above, you simply select (high-light) the range that you wish to transpose and click on a button to execute the code.

Following is the link to my test work book which demonstrates both options for you.

https://www.dropbox.com/s/eb5dop4wq0aaxlm/Corescript%28Transpose%20using%20range%20Input%20Box%20or%20selection%29.xlsm?dl=0

For the first code above, click on the "Do Stuff" button first to make the Input Box appear then select the range to be transposed and then click OK (only one range at a time). For the second code above, first select (high-light) the range to be transposed and then click on the "Do Stuff 2" button to execute the code.

In both the codes, you will see a Delete line of code in green font. If you wish to delete the ranges once transposed, then just remove the apostrophe from the front of the line of code.

I hope that this helps.

Cheerio,
vcoolio.
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
3
Registration date
Friday April 29, 2016
Status
Member
Last seen
May 2, 2016

vcoolio,

its works thank you for your help but can i run automatically without click button

best regards
Posts
1292
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
May 7, 2021
230
Hello Corescript,

It can be but, tell me, will the range always be five rows?

Salamat,
vcoolio.
Posts
3
Registration date
Friday April 29, 2016
Status
Member
Last seen
May 2, 2016

yes it always five rows

Thank you vcoolio :)
Posts
1292
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
May 7, 2021
230
Hello Corescript,

A Double Click event should do it for you with the following code:-

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim x As Integer
    Dim r As Range
    Dim rng As Range
    Dim lr As Long
    
lr = Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("A2:A" & lr)
x = 1

For Each rng In r
    If ActiveCell.Column = x Then
    r.Offset(, x - 1).Copy Sheet1.Range("A" & Rows.Count).End(3)(2)
    End If
    x = x + 1
Next
End Sub


The code needs to go into the worksheet module so right click on your source sheet tab and from the menu that appears, select "view code". In the big white field that appears, paste the above code.
Back in your work sheet, to see the code work, double click on any column cell with data in it (starting from the left or Column B: double click on Willy) and the data will be transposed as per your request.

Try it in the test work book first.

I hope that this solves your query.

Cheerio,
vcoolio.

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!