Sub TransposeData()
Dim sh As Worksheet, sh1 As Worksheet
Dim cell As Range, rw As Long, i As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Summary").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add Befo=Worksheets(1)
ActiveSheet.Name = "Summary"
Set sh1 = Worksheets("Summary")
rw = 1
For Each sh In Worksheets
If sh.Name < "Summary" Then
rw = rw + 1
i = 0
For Each cell In sh.Range("h20, c23, c24, h28")
i = i + 1
sh1.Cells(rw, i).Value = cell.Value
Next
sh1.Cells(rw, i + 1).Value = sh.Name
End If
Next sh
End Sub
--
Regards,
Tom Ogilvy





"mjwillyone " wrote in message
...
Friends,

I have a need to create a macro that will transpose data from all of
the pages (tabs) of an Excel spreadsheet onto a new tab. The
information I need is contained in the same cells on each of the
worksheet pages. How can I transpose the data that I need?

Here is an example of what I have and the cells that need to be
transposed:

Page 1 - cell h20, c23, c24, h28
Page 2 - cell h20, c23, c24, h28
page 3 - cell h20, c23, c24, h28
etc.

I need to move this data to a new page (page 4) where only the cell
values (not the fourmulas that are present) are listed on the new page
- one row for each page. I don't need header titles created in the
macro. The catch? Each tab is individually named after the employee
whose data appears on the page and I need the macro to create then name
a new page to hold the transposed data.

Can anyone help create a macro to do this??
Thank you very much for your help!

Mike


---
Message posted from http://www.ExcelForum.com/