Hello,

Below is code to move data from columns to rows.
It is current set to work on "Sheet1" but I would like to be able to
run it on the "activesheet" -how can I do this?

I have tried simply changing to "activesheet" or
sheets.application.activesheet however the macro just continues to
loop rather that posting data into rows.

Any advice would be appreciated.


Sub CWI_Column2Rows()
Dim Table As Range
Dim DestinationLoc As Range
Dim WS As Worksheet
Set WS = Sheets.Add
'-----------------------------------------------------------------

With Sheets("Sheet1")
Set startCell = .Range("A1")
LastCol = startCell.End(xlToRight).Column
LastRow = startCell.End(xlDown).Row
Set Table = .Range(startCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = WS.Range("A1")
Call CWI_MakeRows(Table, DestinationLoc)


End Sub
Sub CWI_MakeRows(Target As Range, Destination As Range)


NumCols = Target.Columns.Count
numRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To numRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset,
1).Value
Destination.Offset(NewRowOffset, 1) = Target(1,
ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset,
ColOffset)
NewRowOffset = NewRowOffset + 1

Next ColOffset
Next RowOffset
End Sub