CODEWITHSUNDEEP
excelvbatranspose
N S
N S

Reputation: 91

Transpose in place in excel vba

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

and i want the output to look like below.

enter image description here

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

Upvotes: 1

Views: 50

Answers (1)

user3598756
user3598756

Reputation: 29421

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

Upvotes: 1

Related Questions