Sub
TransposeData()
Dim
wshData
As
Worksheet
Dim
wshTrans
As
Worksheet
Dim
lngRowTr
As
Long
, lngRow
As
Long
Set
wshData = Worksheets(1)
Set
wshTrans = Worksheets(2)
lngRowTr = 1
Application.ScreenUpdating =
False
wshTrans.UsedRange.Delete shift:=xlUp
For
lngRow = 1
To
8760
Step
24
wshData.Range(wshData.Cells(lngRow, 1), wshData.Cells(lngRow + 23, 1)).Copy
lngRowTr = lngRowTr + 1
wshTrans.Cells(lngRowTr, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=
False
, Transpose:=
True
VBA.DoEvents
Next
If
Not
Application.CutCopyMode =
False
Then
Application.CutCopyMode =
False
End
If
Application.ScreenUpdating =
True
End
Sub