Run macro on Active sheet - Columns to rows

[ra]

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

 

[Don Guillett]

with activesheet

 

[Patrick Molloy]

change this
Set WS = Sheets.Add

to this
Set WS = activesheet

 

[Patrick Molloy]

beg pardon
ws is is used for the destination

instead change this
With Sheets("Sheet1")

to
With ActiveSheet

 

[Patrick Molloy]

Q: Why not just copy the data and use pastespecial TRANSPOSE?

 

[ra]

change this
Set WS = Sheets.Add

to this
Set WS = activesheet













- Show quoted text -

Hi,
Thanks for help however that doesnt work in this case as:
WS is the new sheet created to post the data in to so I can't make
this the active sheet or the data will post overtop of source.

I have tried changing 'With Sheets("Sheet1") to "With Activesheet"
however then the macro wont solve and just keeps loading.

regards
Richard

 

[ra]

Q: Why not just copy the data and use pastespecial TRANSPOSE?













- Show quoted text -

Hi,
I cant use TRANSPOSE as that doesnt put the data into the correct
format. I need each variable in a seperate column and each change to
be pasted below.

 

[Patrick Molloy]

yes, sorry, see my later post

Hi,
Thanks for help however that doesnt work in this case as:
WS is the new sheet created to post the data in to so I can't make
this the active sheet or the data will post overtop of source.

I have tried changing 'With Sheets("Sheet1") to "With Activesheet"
however then the macro wont solve and just keeps loading.

regards
Richard

 

[Don Guillett]

Sub MakeNewSheetFromAnySheetSAS()
Dim lc As Double
Dim i As Long
Dim dlr As Long
Dim SourceSheet As String

Application.ScreenUpdating = False
SourceSheet = ActiveSheet.Name
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets.Add
With Sheets(SourceSheet)
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(dlr, 1).Resize(lc - 1).Value = .Cells(i, 1).Value
.Cells(1, 2).Resize(, lc - 1).Copy
Cells(dlr, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True

.Cells(i, 2).Resize(, lc - 1).Copy
Cells(dlr, 3).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Next i
End With
'housekeeping
Range("a2").Select
ActiveWindow.FreezePanes = True
Range("a1") = "Category"
Range("b1") = "Mon"
Range("c1") = " Amount"
Columns(3).Style = "Comma"
Columns.AutoFit
'===
Application.ScreenUpdating = True
'MsgBox "Done"
ActiveSheet.Name = InputBox("Enter New Sheet Name")
End Sub