If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Buyone" wrote in message
...
Hello,

I found and borrowed this macro from Dave Peterson. It works, but i need
to
add in a couple of things to make my life that one bit easier.

I need to run this over a number of sheets so need the code to do that,
and
call the new sheets "Sheet Name" Reform.

Also, I have a date in B2 (that chages as you go down the rows) that has
to
go next to each of the indivdual time in the column.

So i need ;
B C D E......AA
14-Oct 01:23 06:21 06:58

To turn into (in a new sheet)
A B
14-Oct 01:23
14-Oct 06:21
14-Oct 06:58

This code puts the times in the order i need but just in column A, and i
need to include the dates.

I need some VBA hlep.

Thanks in advance

Sub rowstocol()

Dim wks As Worksheet
Dim colnos As Long
Dim CopytoSheet As Worksheet

If ActiveSheet.Name = "A2" 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 = "A2" Then
Application.DisplayAlerts = False
Sheets("A2").Delete
End If
End With
Next
Application.DisplayAlerts = True
Set CopytoSheet = Worksheets.Add
CopytoSheet.Name = "A2"
wks.Activate
Range("C1").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("A2").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 'note: changed from 2 to 1
' Selection.EntireRow.Insert 'note: I have remmed out this line
wks.Activate
ActiveCell.Select
Loop


Sheets("A2").Activate
End If
End Sub