Macro to transpose column to rows

Status
Not open for further replies.

nahomi23

New Member
Joined
Mar 9, 2021
Messages
7
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hello,

I need your help to make a macro that does the following:

They give me the data in this way


And the macro should convert it like this


Categoría 1
a
b
c
d
b1
c1
d1
b1
c1
d1
Categoría 2
z
w
x
y
xy
w1
x1
y1
w2
x2
y2
xy2
w3
x3
y3
w4
x4
y4
xy4

At the moment I have this as a code but it does not do me well

Categoría 1abcd
b1c1d1
Categoría 2zwxyxy
w1x1y1
w2x2y2xy2
w3x3y3
w4x4y4

VBA Code:
[CODE=vba]VBA Code:
Option Explicit
Option Base 1

Sub obtener()

Dim r As Range, fr%, cr%
Set r = Range("A1").CurrentRegion

Dim z As Object, zs$, M(1 To 5)
Set z = CreateObject("scripting.dictionary")
Dim K As New Collection, ks$, kn%


On Error Resume Next 'para la K
For fr = 1 To r.Rows.Count

zs = r(fr, 1).Row

If r(fr, 1) Like "Categor=*" Then

ks = ""
For cr = 2 To 4
ks = ks & r(fr + cr, 1)
Next
K.Add ks, ks


If K.Count > kn Then
kn = K.Count
Else
fr = fr + 5
GoTo sigue
End If


M(1) = r(fr, 1)
fr = fr + 1
M(2) = r(fr, 1)
fr = fr + 1
M(3) = r(fr, 1)
fr = fr + 1
M(4) = r(fr, 1)
fr = fr + 1
M(5) = r(fr, 1)
z.Add zs, M()
Else
ks = ""
For cr = 0 To 2
ks = ks & r(fr + cr, 1)
Next
K.Add ks, ks

If K.Count > kn Then
kn = K.Count
Else
fr = fr + 2
GoTo sigue
End If

' zs = r(fr, 1).Row
M(1) = Empty
M(2) = Empty
M(3) = r(fr, 1)
fr = fr + 1
M(4) = r(fr, 1)
fr = fr + 1
M(5) = r(fr, 1)
z.Add zs, M()
End If
sigue:
Next

Columns("C:J").ClearContents
Range("C2").Resize(z.Count, 5) = Application.Index(z.items, 0, 0)
End Sub
[/CODE]


I would greatly appreciate your help
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,219
Office Version
  1. 365
Platform
  1. Windows
Duplicate to: Macro that transposes the information as follows

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.
 
Status
Not open for further replies.

Forum statistics

Threads
1,140,999
Messages
5,703,639
Members
421,307
Latest member
morrden86

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
Top