Copy horizontal data vertically

S

swapnilk

Board Regular
Joined
Apr 25, 2016
Messages
78
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
Hi,

I have excel data as under, is it possible to copy horizontal data vertically as shown below?


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]EmpID
[/TD]
[TD]123
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]1111
[/TD]
[TD]2222
[/TD]
[TD]3333
[/TD]
[TD][/TD]
[TD]3333
[/TD]
[TD]2222
[/TD]
[TD]1111
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]5555
[/TD]
[TD]6666
[/TD]
[TD]4444
[/TD]
[TD][/TD]
[TD]2222
[/TD]
[TD]7777
[/TD]
[TD]1111
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]4444
[/TD]
[TD]9999
[/TD]
[TD]8888
[/TD]
[TD][/TD]
[TD]555
[/TD]
[TD]56
[/TD]
[TD]468
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]EmpID
[/TD]
[TD]124
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]111
[/TD]
[TD]223
[/TD]
[TD]125
[/TD]
[TD][/TD]
[TD]45452
[/TD]
[TD]45454
[/TD]
[TD]454
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]1234
[/TD]
[TD]5684
[/TD]
[TD]5689
[/TD]
[TD][/TD]
[TD]5354
[/TD]
[TD]697
[/TD]
[TD]359
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]EmpID
[/TD]
[TD]125
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]1246
[/TD]
[TD]2685
[/TD]
[TD]6564
[/TD]
[TD][/TD]
[TD]4789
[/TD]
[TD]665
[/TD]
[TD]567
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Result
[/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]EmpID
[/TD]
[TD]123
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]1111
[/TD]
[TD]2222
[/TD]
[TD]3333
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]5555
[/TD]
[TD]6666
[/TD]
[TD]4444
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]4444
[/TD]
[TD]9999
[/TD]
[TD]8888
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]3333
[/TD]
[TD]2222
[/TD]
[TD]1111
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]2222
[/TD]
[TD]7777
[/TD]
[TD]1111
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]555
[/TD]
[TD]56
[/TD]
[TD]468
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]EmpID
[/TD]
[TD]124
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]111
[/TD]
[TD]223
[/TD]
[TD]125
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]1234
[/TD]
[TD]5684
[/TD]
[TD]5689
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]45452
[/TD]
[TD]45454
[/TD]
[TD]454
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD]5354
[/TD]
[TD]697
[/TD]
[TD]359
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
and so on....

The data beyond column D for that particular EmpID gets copied just above the next EmplID.

Is it even possible to do this?
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
swapnilk,

Here is a macro solution for you to consider, that is based on your two flat text displays.

Sample raw data in the active worksheet:


Excel 2007
ABCDEFGH
1EmpID123
2111122223333333322221111
3555566664444222277771111
444449999888855556468
5EmpID124
61112231254545245454454
71234568456895354697359
8EmpID125
91246268565644789665567
10
11
12
13
14
15
16
17
18
19
Sheet1


And, after the macro:


Excel 2007
ABCDEFGH
1EmpID123
2111122223333
3555566664444
4444499998888
5
6333322221111
7222277771111
855556468
9EmpID124
10111223125
11123456845689
12
134545245454454
145354697359
15EmpID125
16124626856564
17
184789665567
19
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code: 
Sub ReorganizeData()
' hiker95, 02/03/2017, ME989196
Dim wa As Worksheet, Area As Range, sr As Long, er As Long, nr As Long, lr As Long, n As Long
Application.ScreenUpdating = False
Set wa = ActiveSheet
With wa
  lr = .Columns("A:C").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  For Each Area In .Range("E2:G" & lr).SpecialCells(xlCellTypeConstants).Areas
    With Area
      sr = .Row
      er = sr + .Rows.Count - 1
      n = .Rows.Count
      If sr = er And er = lr And n = 1 Then
        nr = lr + 2
        Range("A" & nr).Resize(, 3).Value = Range("E" & sr & ":G" & er).Value
        Range("E" & sr & ":G" & er).ClearContents
      Else
        wa.Rows(er + 1).Resize(n + 1).Insert
        Range("A" & er + 2).Resize(.Rows.Count, 3).Value = Range("E" & sr & ":G" & er).Value
        Range("E" & sr & ":G" & er).ClearContents
      End If
    End With
    lr = lr + n + 1
  Next Area
  .Columns(1).Resize(, 3).AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorganizeData macro.
 
Upvote 0
swapnilk,

Here is a new macro solution (that is shorter) for you to consider, that is based on your two flat text displays.

With the same screenshots, and, instructions as my last reply #2.


Code: 
Sub ReorganizeData_V2()
' hiker95, 02/04/2017, ME989196
Dim wa As Worksheet, Area As Range, sr As Long, er As Long, lr As Long, n As Long
Application.ScreenUpdating = False
Set wa = ActiveSheet
With wa
  lr = .Columns("A:C").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  For Each Area In .Range("E1:G" & lr).SpecialCells(xlCellTypeConstants).Areas
    With Area
      sr = .Row
      er = sr + .Rows.Count - 1
      n = .Rows.Count
      wa.Rows(er + 1).Resize(n + 1).Insert
      Range("A" & er + 2).Resize(.Rows.Count, 3).Value = Range("E" & sr & ":G" & er).Value
      Range("E" & sr & ":G" & er).ClearContents
    End With
  Next Area
  .Columns(1).Resize(, 3).AutoFit
End With
Application.ScreenUpdating = True
End Sub


Then run the ReorganizeData_V2 macro.
 
Upvote 0
Assuming layout per post #2 and nothing in columns H:K, this variation might also do what you want.

Rich (BB code): 
Sub Rearrange()
  Dim rA As Range
  
  Application.ScreenUpdating = False
  For Each rA In Columns("E:G").SpecialCells(xlConstants).Areas
    With rA
      .Offset(-1).Resize(.Rows.Count + 1, 7).Cut
      .Offset(.Rows.Count, -4).Insert Shift:=xlDown
    End With
  Next rA
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Matching cells, comparing values and producing total
Replies
3
Views
441
JamesCanale
JamesCanale
A
  • Question Question
Match WorkSheets back to a Master Worksheet with current years data on it.
Replies
3
Views
470
mumps
mumps
M
  • Question Question
VBA Button That Will Clear Completed Job And Move Active Jobs UP
Replies
1
Views
421
Joe4
Joe4
M
  • Question Question
Linking between multiple sheets/workbooks
Replies
2
Views
245
MasterBash
M
C
  • Question Question
User Form With Multiple Passwords
Replies
3
Views
2K
dmt32
D

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top