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:
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"
s2.Range("C1") = "Unidad"
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.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to freeze panes using VBA |
| How to data trim and clean cell values with VBA code |
| How to use Excel VBA userform list box |
| How to maximise IE window in VBA |
| How to generate multiple line charts VBA |
| How to create VBA to copy specific column from one sheet to another |
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.