Reply to thread

Message: [QUOTE="Tim Williams, post: 6035583"] 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 [/QUOTE]