Restructure Excel Data like Pivot using Macro: Repeat the row for each column value

 In Excel here is the Sorce Table


And if you want to get data in this format 



Use the following MAcro > Developer > Visual Basic > Insert Module

Sub RestructureData()

    Dim ws As Worksheet

    Dim LastRow As Long

    Dim DestRange As Range

    Dim Col1Cell As Range

    Dim DestRow As Long

    

    ' Define the worksheet containing the source data

    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    

    ' Clear any existing data in columns F and G

    ws.Range("F:G").Clear

    

    ' Set the initial row for the destination data

    DestRow = 2

    

    ' Find the last row in column A with data

    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    

    ' Loop through each row in the source data

    For Each Col1Cell In ws.Range("A2:A" & LastRow)

        ' Get the value from Col1 (M1, M2, M3)

        Dim Col1Value As String

        Col1Value = Col1Cell.Value

        

        ' Loop through columns B, C, and D (Col2, Col3, Col4)

        For i = 2 To 4

            ' Get the value from Col2, Col3, or Col4

            Dim ColValue As Variant

            ColValue = Col1Cell.Offset(0, i - 1).Value

            

            ' Check if the value is not empty

            If ColValue <> "" Then

                ' Write Col1Value and ColValue to the destination columns

                ws.Cells(DestRow, "F").Value = Col1Value

                ws.Cells(DestRow, "G").Value = ColValue

                

                ' Increment the destination row

                DestRow = DestRow + 1

            End If

        Next i

    Next Col1Cell

End Sub


Comments