Sub rowstocol()
'many columns and rows to one column on a new worksheet
Dim wks As Worksheet
Dim colnos As Long
Dim CopytoSheet As Worksheet

If ActiveSheet.Name = "Copyto" Then
MsgBox "Active Sheet Not Valid" & Chr(13) _
& "Try Another Worksheet."
Exit Sub
Else
Set wks = ActiveSheet
Application.ScreenUpdating = False
For Each Wksht In Worksheets
With Wksht
If .Name = "Copyto" Then
Application.DisplayAlerts = False
Sheets("Copyto").Delete
End If
End With
Next
Application.DisplayAlerts = True
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "Copyto"
wks.Activate
Range("A1").Select
colnos = InputBox("Enter Number of Columns to Transpose to Rows")

Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
With ActiveCell
.Resize(1, colnos).Copy
End With
Sheets("Copyto").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, _
SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = False
ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Select
ActiveCell.Offset(1, 0).Select

wks.Activate
ActiveCell.Select
Loop
Sheets("Copyto").Activate
End If
End Sub


Gord Dibben MS Excel MVP

On Mon, 15 Mar 2010 13:55:01 -0700, Jethro Bodeene Jethro
wrote:

I have a spreadsheet with 151 columns by 49 rows of data. I need to
transpose this data from its current state, to only 1 vertical column. How
can I do this? Thks