VBA Code to transpose data from Sheet 1 to Sheet 2 in a specific order

Hi all,

I'm using Excel 2013 and I need help for a VBA code that will help me transpose data from Sheet 1 of my workbook to its Sheet 2. However, the "transpose" needs to be in a specific order.

Please have a look at the attached file. My original data is in Sheet 1 and I need it to transpose into the data shown in Sheet 2.

transpose example.xlsx

Thanks for your help.

-Ali

Try this:-
Results sheet2.

Sub MG24Apr54
Dim Rng As Range, Dn As Range
Dim c As Long
c = 1
With Sheets("Sheet1")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
End With
Application.ScreenUpdating = False
For Each Dn In Rng
    With Sheets("Sheet2")
        Dn.Copy
        .Cells(c, 1).Resize(12).PasteSpecial , Transpose:=True
        Dn.Offset(, 1).Resize(, 12).Copy
        .Cells(c, 2).PasteSpecial , Transpose:=True
        Rng(1).Offset(-1, 1).Resize(, 12).Copy
        .Cells(c, 3).PasteSpecial , Transpose:=True
        c = c + 12
    End With
Next Dn
Application.ScreenUpdating = True
End Sub

Regards Mick

Sub xmmx()
Dim a As Range, x, c As Long, r As Long

Set a = Sheets("sheet1").Cells(1).CurrentRegion
c = a.Columns.Count - 1
r = 1
With Sheets("sheet2")
For Each x In a.Resize(, 1)
    If Len(x) > 0 Then
        .Cells(r, 1).Resize(c) = x
        .Cells(r, 2).Resize(c) = Application.Transpose(x.Offset(, 1).Resize(, c))
        .Cells(r, 3).Resize(c) = Application.Transpose(a(2).Resize(, c))
        r = r + c
    End If
Next x
.Cells(3).Resize(r - 1).NumberFormat = a(2).NumberFormat
.Cells(3).Resize(r - 1).Font.Bold = True
End With
End Sub

Kalak, I will have a look at your solution too and report back. Thanks.

Thank you MickG! Works beautifully! Just what I was looking for!

You're welcome
NB:- "Kalak's" code is a much better effort !!!!!

Thanks Mick.

I tried them both and both seem fine to me.

Only if there's a large dataset ...