View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Don Guillett Don Guillett is offline
external usenet poster
 
Posts: 10,124
Default Run macro on Active sheet - Columns to rows

with activesheet

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"ra" wrote in message
...
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