Here's the code you need
Code:
Sub ConsolidateByTranspose()
Const lngColumnsToTranspose As Long = 29
Const lngRowSetsToTranspose As Long = 12
Const lngStandardInitialCol As Long = 5
Const strOutputSheetName As String = "Output Result"
Const strSourceSheetName As String = "data"
Dim lngRows As Long
Dim wks As Worksheet
Dim wksInput As Worksheet: Set wksInput = Worksheets(strSourceSheetName)
On Error Resume Next
Set wks = Worksheets(strOutputSheetName)
Err.Clear: On Error GoTo 0: On Error GoTo -1
If Not wks Is Nothing Then
wks.UsedRange.Clear
Else
Set wks = Sheets.Add(After:=Sheets(Sheets.Count))
wks.Name = strOutputSheetName
End If
With wks
.Cells(1).Resize(, lngStandardInitialCol + 1).Value = wksInput.Cells(1).Resize(, lngStandardInitialCol + 1).Value
.Cells(1, lngStandardInitialCol + 2).Resize(, lngRowSetsToTranspose).Value = Application.Transpose(wksInput.Cells(2, lngStandardInitialCol + 1).Resize(lngRowSetsToTranspose).Value)
For lngRows = 1 To (wksInput.Cells(wksInput.Rows.Count, 1).End(xlUp).Row - 1) / lngRowSetsToTranspose
.Cells(lngColumnsToTranspose * (lngRows - 1) + 2, 1).Resize(lngColumnsToTranspose, lngStandardInitialCol).Value = wksInput.Cells(lngRowSetsToTranspose * (lngRows - 1) + 2, 1).Resize(, lngStandardInitialCol).Value
.Cells(lngColumnsToTranspose * (lngRows - 1) + 2, lngStandardInitialCol + 1).Resize(lngColumnsToTranspose).Value = Application.Transpose(wksInput.Cells(1, lngStandardInitialCol + 2).Resize(, lngColumnsToTranspose).Value)
.Cells(lngColumnsToTranspose * (lngRows - 1) + 2, lngStandardInitialCol + 2).Resize(lngColumnsToTranspose, lngRowSetsToTranspose).Value = Application.Transpose(wksInput.Cells(lngRowSetsToTranspose * (lngRows - 1) + 2, lngStandardInitialCol + 2).Resize(lngRowSetsToTranspose, lngColumnsToTranspose).Value)
Next lngRows
End With
End Sub
Bookmarks