Transpose the Data and copy

[webmax]

Hi

Kindly find the attached file which contains an input and output


I need the macro that the data of the above to copy in the Transpose format and fill the heading which was shown in example in output file.

Regards
Shahul

 

[YasserKhalil]

Try this code

Sub Transpose()
    Dim outSH As Worksheet, I As Integer, J As Integer, outRow As Integer
   
    Set outSH = Sheets("Sheet2")
   
    For J = 2 To 4          'Columns
        For I = 3 To 7      'Rows
            outRow = outSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            outSH.Cells(outRow, 1).Value = Sheet1.Cells(I, 1).Value
            outSH.Cells(outRow, 2).Value = Sheet1.Cells(I, J).Value
            outSH.Cells(outRow, 3).Value = Sheet1.Cells(2, J).Value
        Next I
    Next J
End Sub

 

[Marc L]

Hi !

Many ways to achieve this, at beginner level like this :
(result starts in cell H3)​

Sub Demo1()
    Application.ScreenUpdating = False
                            R& = 3
With Cells(1).CurrentRegion.Rows
        N& = .Count - 2
    For C& = 2 To .Columns.Count
        .Cells(3, 1).Resize(N).Copy .Cells(R, 8)
        .Cells(3, C).Resize(N).Copy .Cells(R, 9)
        .Cells(2, C).Copy .Cells(R, 10).Resize(N)
        R = R + N
    Next
End With
    Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Marc L]

If you wanna play with arrays :​

Sub Demo2()
    With Cells(1).CurrentRegion.Rows
        VA = .Item("2:" & .Count)
    End With
    ReDim VT(1 To (UBound(VA) - 1) * (UBound(VA, 2) - 1), 1 To 3)
For C& = 2 To UBound(VA, 2)
    For R& = 2 To UBound(VA)
              L& = L& + 1
        VT(L, 1) = VA(R, 1)
        VT(L, 2) = VA(R, C)
        VT(L, 3) = VA(1, C)
    Next
Next
    [H3:J3].Resize(UBound(VT)).Value = VT
End Sub

Do you like it ? So thanks to click on bottom right Like !
​