Hi again,
Adjust as desired. I did not add so many rows between, as it seemed you may have layed out the example for being easy to read, more than what would seem desired?
In a Standard Module:
Option Explicit
Sub TransposeRecords()
Dim _
wksOutput As Worksheet, _
aryInput As Variant, _
aryOutput As Variant, _
lRowCount As Long, _
lRecordCount As Long, _
lRecord As Long, _
lCurTopRow As Long, _
lURowOut As Long, _
lOffset As Long
Const START_AT_ROW As Long = 1
With ThisWorkbook
'// Change to suite or use sheet's codename //
With .Worksheets("orignal")
'// Add a sheet for output. //
Set wksOutput = .Parent.Worksheets.Add(After:=.Parent.Worksheets(.Name))
'// Grab all the source data. //
aryInput = .Range(.Cells(START_AT_ROW, 1), _
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 6) _
).Value
'// Get total rows of source data. //
lRowCount = .Cells(.Rows.Count, "A").End(xlUp).Row - START_AT_ROW + 1
'// See how many recordsets there are //
lRecordCount = lRowCount \ 38
'// Size out output array. //
ReDim aryOutput(1 To (7 * lRecordCount), 1 To 38)
'// We will be looping thru chunks of both in/out arrays; set initial //
'// positions //
lCurTopRow = 0
lURowOut = 1
'// Loop thru recordsets //
For lRecord = 1 To lRecordCount
'// Set top row of current chunk of input array //
lCurTopRow = (lRecord * 38) - 37
'// output chunk category like "Quarterly Results of GTL" and //
'// whatever this is called: "------------------- in Rs. Cr. -------------------//
aryOutput(lURowOut, 1) = aryInput(lCurTopRow, 1)
aryOutput(lURowOut + 1, 1) = aryInput(lCurTopRow, 2)
'// "Dates". These are actually strings, you may need to coerce if //
'// they are to be calculated against later. Not sure why you wanyted //
'// to skip over so many columns, but as shown in example supplied. //
aryOutput(lURowOut + 1, 6) = aryInput(lCurTopRow + 5, 2)
aryOutput(lURowOut + 2, 6) = aryInput(lCurTopRow + 5, 3)
aryOutput(lURowOut + 3, 6) = aryInput(lCurTopRow + 5, 4)
aryOutput(lURowOut + 4, 6) = aryInput(lCurTopRow + 5, 5)
aryOutput(lURowOut + 5, 6) = aryInput(lCurTopRow + 5, 6)
'// Sub categories like "Sales Turnover" etc //
aryOutput(lURowOut, 8) = aryInput(lCurTopRow + 7, 1)
aryOutput(lURowOut, 9) = aryInput(lCurTopRow + 8, 1)
aryOutput(lURowOut, 10) = aryInput(lCurTopRow + 9, 1)
aryOutput(lURowOut, 11) = aryInput(lCurTopRow + 10, 1)
aryOutput(lURowOut, 12) = aryInput(lCurTopRow + 11, 1)
aryOutput(lURowOut, 13) = aryInput(lCurTopRow + 12, 1)
aryOutput(lURowOut, 14) = aryInput(lCurTopRow + 13, 1)
aryOutput(lURowOut, 15) = aryInput(lCurTopRow + 14, 1)
aryOutput(lURowOut, 16) = aryInput(lCurTopRow + 15, 1)
aryOutput(lURowOut, 17) = aryInput(lCurTopRow + 16, 1)
aryOutput(lURowOut, 18) = aryInput(lCurTopRow + 17, 1)
aryOutput(lURowOut, 19) = aryInput(lCurTopRow + 18, 1)
aryOutput(lURowOut, 20) = aryInput(lCurTopRow + 19, 1)
aryOutput(lURowOut, 21) = aryInput(lCurTopRow + 20, 1)
aryOutput(lURowOut, 22) = aryInput(lCurTopRow + 21, 1)
aryOutput(lURowOut, 23) = aryInput(lCurTopRow + 22, 1)
aryOutput(lURowOut, 24) = aryInput(lCurTopRow + 23, 1)
aryOutput(lURowOut, 25) = aryInput(lCurTopRow + 24, 1)
aryOutput(lURowOut, 26) = aryInput(lCurTopRow + 25, 1)
aryOutput(lURowOut, 27) = aryInput(lCurTopRow + 26, 1)
aryOutput(lURowOut, 28) = aryInput(lCurTopRow + 27, 1)
aryOutput(lURowOut, 29) = aryInput(lCurTopRow + 28, 1)
aryOutput(lURowOut, 30) = aryInput(lCurTopRow + 29, 1)
aryOutput(lURowOut, 31) = aryInput(lCurTopRow + 30, 1)
aryOutput(lURowOut, 32) = aryInput(lCurTopRow + 31, 1)
aryOutput(lURowOut, 33) = aryInput(lCurTopRow + 32, 1)
aryOutput(lURowOut, 34) = aryInput(lCurTopRow + 33, 1)
aryOutput(lURowOut, 35) = aryInput(lCurTopRow + 34, 1)
aryOutput(lURowOut, 36) = aryInput(lCurTopRow + 35, 1)
aryOutput(lURowOut, 37) = aryInput(lCurTopRow + 36, 1)
aryOutput(lURowOut, 38) = aryInput(lCurTopRow + 37, 1)
'// Loop thru vals, transposing along the way. I would note that whatever//
'// your source is, you are getting double unaries as zeros and that this//
'// looks like the start of a formula to Excel. May want to clean up on//
'// way in, or change numberformat of dest cells to text? //
For lOffset = 1 To 5
aryOutput(lURowOut + lOffset, 8) = aryInput(lCurTopRow + 7, 1 + lOffset)
aryOutput(lURowOut + lOffset, 9) = aryInput(lCurTopRow + 8, 1 + lOffset)
aryOutput(lURowOut + lOffset, 10) = aryInput(lCurTopRow + 9, 1 + lOffset)
aryOutput(lURowOut + lOffset, 11) = aryInput(lCurTopRow + 10, 1 + lOffset)
aryOutput(lURowOut + lOffset, 12) = aryInput(lCurTopRow + 11, 1 + lOffset)
aryOutput(lURowOut + lOffset, 13) = aryInput(lCurTopRow + 12, 1 + lOffset)
aryOutput(lURowOut + lOffset, 14) = aryInput(lCurTopRow + 13, 1 + lOffset)
aryOutput(lURowOut + lOffset, 15) = aryInput(lCurTopRow + 14, 1 + lOffset)
aryOutput(lURowOut + lOffset, 16) = aryInput(lCurTopRow + 15, 1 + lOffset)
aryOutput(lURowOut + lOffset, 17) = aryInput(lCurTopRow + 16, 1 + lOffset)
aryOutput(lURowOut + lOffset, 18) = aryInput(lCurTopRow + 17, 1 + lOffset)
aryOutput(lURowOut + lOffset, 19) = aryInput(lCurTopRow + 18, 1 + lOffset)
aryOutput(lURowOut + lOffset, 20) = aryInput(lCurTopRow + 19, 1 + lOffset)
aryOutput(lURowOut + lOffset, 21) = aryInput(lCurTopRow + 20, 1 + lOffset)
aryOutput(lURowOut + lOffset, 22) = aryInput(lCurTopRow + 21, 1 + lOffset)
aryOutput(lURowOut + lOffset, 23) = aryInput(lCurTopRow + 22, 1 + lOffset)
aryOutput(lURowOut + lOffset, 24) = aryInput(lCurTopRow + 23, 1 + lOffset)
aryOutput(lURowOut + lOffset, 25) = aryInput(lCurTopRow + 24, 1 + lOffset)
aryOutput(lURowOut + lOffset, 26) = aryInput(lCurTopRow + 25, 1 + lOffset)
aryOutput(lURowOut + lOffset, 27) = aryInput(lCurTopRow + 26, 1 + lOffset)
aryOutput(lURowOut + lOffset, 28) = aryInput(lCurTopRow + 27, 1 + lOffset)
aryOutput(lURowOut + lOffset, 29) = aryInput(lCurTopRow + 28, 1 + lOffset)
aryOutput(lURowOut + lOffset, 30) = aryInput(lCurTopRow + 29, 1 + lOffset)
aryOutput(lURowOut + lOffset, 31) = aryInput(lCurTopRow + 30, 1 + lOffset)
aryOutput(lURowOut + lOffset, 32) = aryInput(lCurTopRow + 31, 1 + lOffset)
aryOutput(lURowOut + lOffset, 33) = aryInput(lCurTopRow + 32, 1 + lOffset)
aryOutput(lURowOut + lOffset, 34) = aryInput(lCurTopRow + 33, 1 + lOffset)
aryOutput(lURowOut + lOffset, 35) = aryInput(lCurTopRow + 34, 1 + lOffset)
aryOutput(lURowOut + lOffset, 36) = aryInput(lCurTopRow + 35, 1 + lOffset)
aryOutput(lURowOut + lOffset, 37) = aryInput(lCurTopRow + 36, 1 + lOffset)
aryOutput(lURowOut + lOffset, 38) = aryInput(lCurTopRow + 37, 1 + lOffset)
Next
'// adjust to next chunk in output array //
lURowOut = lURowOut + 7
Next
End With
End With
'// Size an output Range to match the output array size, plunk in the array, fit //
'// columns. //
With wksOutput.Range("A1").Resize(UBound(aryOutput, 1), UBound(aryOutput, 2))
.Value = aryOutput
.EntireColumn.AutoFit
End With
End Sub
Hope that helps,
Mark
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.