# OzGrid

### How to use Excel VBA Macro to convert multiple columns to multiple rows

Requirement:

The user has a 13 (might 14) column table and want to convert the columns into multiple rows via a macro
Here's the original table attached

Is there a macro that convert the items into multiple rows?

ID Prod Price Year Month
6 1 7 2017 01
6 2 8 2017 01
6 3 9 2017 01

Solution:

Code:
```Option Explicit

Sub ATransProd()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Input")
Set s2 = Sheets("OutputX")
s2.Range("A1") = s1.Range("A1")
s2.Range("B1") = "Producto"
s1.Range("L1:N1").Copy s2.Range("D1")
Dim lr As Long, lr2 As Long, i As Long
lr = s1.Range("A" & Rows.Count).End(xlUp).Row
With s1
For i = 2 To lr
lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row
.Range("A" & i).Copy s2.Range("A" & lr2 + 1)
.Range("B" & i & ":F" & i).Copy
s2.Range("B" & lr2 + 1).PasteSpecial xlPasteValues, , , True
.Range("G" & i & ":K" & i).Copy
s2.Range("C" & lr2 + 1).PasteSpecial xlPasteValues, , , True
.Range("L" & i & ":N" & i).Copy s2.Range("D" & lr2 + 1)
Next i
End With
Application.CutCopyMode = False
lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row
For i = lr2 To 2 Step -1
If s2.Range("C" & i) = "" Then
s2.Range("C" & i).EntireRow.Delete
End If
Next i
With s2
For i = 3 To lr2
If .Range("A" & i) = "" Then
.Range("A" & i) = .Range("A" & i - 1)
.Range("D" & i) = .Range("D" & i - 1)
.Range("E" & i) = .Range("E" & i - 1)
.Range("F" & i) = .Range("F" & i - 1)
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "completed"
End Sub```

Obtained from the OzGrid Help Forum.

Solution provided by AlanSidman.

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.

### Gallery

stars (0 Reviews)