re arranging data in a worksheet

[kim]

Hi
I need to have the number data in a worksheet become a row entry.

Current worksheet structure is Column headings are names each row is a
location. The other cells have a number or are blank

Name1 Name 2 Name 3
L1 2 4
L2 12 7
L3 1 2
L4 3 4

I want to have each number value in a new or this worksheet as a row entry
in Column A and keep its location and name information next to it :

Location Name
23 L2 Fred1
56 L3 Jim2
2 L8 Jane 2
I dont want to include blank cells.
So what I need to do is get the next number and it's location and name in
the existing sheet and reorder it as above there is a lot of numbers so a
script to do this would save a lot of time.
Any help appreciated.

 

[Tom Ogilvy]

Sub CopyData()
Dim sh as worksheets, sh1 as worksheets
Dim rw as Long, cell as Range, r as Range
set sh = worksheets.Activesheet
On Error Resume Next
set r = sh.Range("A1").currentRegion.specialCells(xlconstants,xlnumbers)
if r is nothing then
msgbox "No numbers found"
exit sub
end if
On error goto 0
worksheets.Add(after:=worksheets(worksheets.count))
set sh1 = worksheets(worksheets.count)
sh1.Cells(1,2) = "Location"
sh1.Cells(1,3) = "Name"
rw = 2
for each cell in r
sh1.cells(rw,1) = cell.value
sh1.cells(rw,2) = sh.cells(cell.row,1)
sh.cells(rw,3) = sh.cells(1,cell.column)
rw = rw + 1
Next
end sub

 

[kim]

Thank you
When I run the code I get an error at:
set sh = worksheets.Activesheet
"Compile error method or datamember not found D
Do I need to change something here?
Thanks

 

[Tom Ogilvy]

Kim,

Several nasty typos in that - sorry. this was tested and worked as I
expected based on my assumptions of how you data is structured.

Sub CopyData()
Dim sh As Worksheet, sh1 As Worksheet
Dim rw As Long, cell As Range, r As Range
Set sh = ActiveSheet
On Error Resume Next
Set r = sh.Range("A1").CurrentRegion.SpecialCells(xlConstants, xlNumbers)
If r Is Nothing Then
MsgBox "No numbers found"
Exit Sub
End If
On Error GoTo 0
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set sh1 = Worksheets(Worksheets.Count)
sh1.Cells(1, 2) = "Location"
sh1.Cells(1, 3) = "Name"
rw = 2
For Each cell In r
sh1.Cells(rw, 1) = cell.Value
sh1.Cells(rw, 2) = sh.Cells(cell.Row, 1)
sh1.Cells(rw, 3) = sh.Cells(1, cell.Column)
rw = rw + 1
Next
End Sub

 

[kim]

Many Thanks! that did the job

Kim,

Several nasty typos in that - sorry. this was tested and worked as I
expected based on my assumptions of how you data is structured.

Sub CopyData()
Dim sh As Worksheet, sh1 As Worksheet
Dim rw As Long, cell As Range, r As Range
Set sh = ActiveSheet
On Error Resume Next
Set r = sh.Range("A1").CurrentRegion.SpecialCells(xlConstants, xlNumbers)
If r Is Nothing Then
MsgBox "No numbers found"
Exit Sub
End If
On Error GoTo 0
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set sh1 = Worksheets(Worksheets.Count)
sh1.Cells(1, 2) = "Location"
sh1.Cells(1, 3) = "Name"
rw = 2
For Each cell In r
sh1.Cells(rw, 1) = cell.Value
sh1.Cells(rw, 2) = sh.Cells(cell.Row, 1)
sh1.Cells(rw, 3) = sh.Cells(1, cell.Column)
rw = rw + 1
Next
End Sub