OzGrid

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

< Back to Search results

 Category: [Excel]  Demo Available 

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


Gallery



stars (0 Reviews)