if your range is always rectangular and the only thing that varies is the
number of "fixed" columns then something like this should work...


Sub UnPivot()

Dim c, r, f, destcell, irow, m, i, n

c = Selection.Columns.Count
r = Selection.Rows.Count

f = Application.InputBox(prompt:="Number of fixed columns?", Type:=1)
Set destcell = Application.InputBox(prompt:="Select destination", Type:=8)

irow = 0

'iterate through rows
For m = 2 To r

'iterate through columns
For n = f + 1 To c

'copy fixed columns
For i = 1 To f
destcell.Offset(irow, i - 1).Value = _
Selection.Cells(m, i).Value
Next i
'depivot other columns
destcell.Offset(irow, f).Value = _
Selection.Cells(1, n).Value
destcell.Offset(irow, f + 1).Value = _
Selection.Cells(m, n).Value
irow = irow + 1
Next n

Next m
End Sub



Tim

--
Tim Williams
Palo Alto, CA


"DavidH" wrote in message
...
I'm trying to write a macro that rearranges a named range to facilitate
pivot
table manipulation. For example, if A1:D3 is named "MyRange" and is set up
as
follows:

.........North..South..East..West
Jan....100.....200.....300...400
Feb....500.....600.....700...800
Mar...250......350.....450...550

I'd like to rearrange the data on a new sheet as follows:

Jan..North...100
Jan..South...200
Jan..East.....300
Jan..West....400
Feb..North...500
Feb..South...600
Feb..East.....700
Feb..West....800
Mar..North...250
Mar..South...350
Mar..East......450
Mar..West.....550

I run into this situation often, and I've simplified the example above for
presentation purposes. Usually I find myself with several columns of data
that I'd like to repeat, for example an account number, project number,
and
department id (these columns would replace the months in the example
above)
followed by a column for each month. Also, different people hand their
worksheets over to me, so the format & style differs; for instance one
person
may leave zero value cells blank.

Any suggestions on how I can write a generalized macro to handle this
situation would be greatly appreciated.

Thanks,

David