Transpose in place in excel vba-CodePudding

I have a raw data which needs to be split into different columns, the raw data looks like

and i want the output to look like below.

I have a code which does the work when the Column A is not present, I need to modify it along with the column A

the code is

Sub transpose_in_place()
    Dim rw As Long, cl As Long
    With ActiveSheet
        For rw = .Cells(rows.Count, 1).End(xlUp).Row To 2 Step -1
            For cl = .Cells(rw, Columns.Count).End(xlToLeft).Column To 3 Step -1
                If Not IsEmpty(.Cells(rw, cl)) Then
                    .rows(rw   1).Insert
                    .Cells(rw   1, 1) = .Cells(rw, 1).Value2
                    .Cells(rw   1, 2) = .Cells(rw, cl).Value2
                    .Cells(rw, cl).clear
                End If
            Next cl
        Next rw
    End With
End Sub

Im not sure how to modify the code, can someone help me with it. Thanks in advance

CodePudding user response：

Option Explicit

Sub transpose_in_place()
    Dim rw As Long, cl As Long
    With ActiveSheet
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            For cl = .Cells(rw, Columns.Count).End(xlToLeft).Column To 4 Step -1
                If Not IsEmpty(.Cells(rw, cl)) Then
                    .Rows(rw   1).Insert
                    .Cells(rw   1, 1) = .Cells(rw, 1).Value2
                    .Cells(rw   1, 2) = .Cells(rw, 2).Value2
                    .Cells(rw   1, 3) = .Cells(rw, cl).Value2
                    .Cells(rw, cl).Clear
                End If
            Next cl
        Next rw
    End With
End Sub