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