# Macro to transpose column to rows

Status
Not open for further replies.

#### nahomi23

##### New Member
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 1 a b c d b1 c1 d1 Categoría 2 z w x y xy w1 x1 y1 w2 x2 y2 xy2 w3 x3 y3 w4 x4 y4

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

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)
Else
ks = ""
For cr = 0 To 2
ks = ks & r(fr + cr, 1)
Next

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)
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
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.

Status
Not open for further replies.

Replies
13
Views
240
Replies
3
Views
98
Replies
4
Views
107
Replies
3
Views
96
Replies
3
Views
107

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.

### Which adblocker are you using?

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

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