Sub Outline2Columns()
Dim rSrc As Range, rCell As Range
Dim dPrc#
Dim lTov& ' Changed iTov% to lTov&
Dim iShf%, i%, iLvl%, iOut%
Dim vLbl() As Variant
Set rSrc = Range("B5:B19") ' User - Source data
iOut = 4 ' User - Max Outline Level
iShf = 4 ' User - No of columns to offset result ddata
iOut = iOut + 1
ReDim vLbl(1 To iOut)
For Each rCell In rSrc
With rCell
iLvl = .Rows.OutlineLevel
vLbl(iLvl) = .Value
Select Case iLvl
Case iOut - 1
lTov = lTov + 1
vLbl(iOut) = .Offset(0, 1).Value
For i = 1 To iOut
Cells(lTov, i + iShf).Value = vLbl(i)
Next
Case Is >= iOut
Stop
End Select
End With
Next
End Sub
|
