Find, Copy and change from row to column
 

This is getting the best of me, :(

I have S/S with multi worksheets with system and hardware layout. The
problem is it is all done from left to right. I need to find just the
system and write them top to bottum and which tab they were found on a
new worksheet.

So something like this:
1) create new worksheet called systems.
2) goto first worksheet
3) find first row with system in column A
4) copy rest of row (B-AA) to worksheet systems and paste top to bottom
in Column A
5) go back to first worksheet find next system, if not anymore go to
next worksheet.

Any suggestions?

Thanks,
Ron

Find, Copy and change from row to column
 

How would we know it is as system. Are the only entries in column A
systems?

On Error Resume Next
Worksheets.Add( After:=Worksheets(Worksheets.count)).Name = "System"
On Error goto 0
rw = 1
for each sh in Worksheets
if sh.Name < "System" then
set rng = sh.Columns(1).Specialcells(xlConstants)
for each cell in rng
cell.resize(1,27).copy Destination:=Worksheets("System").Cells(rw,1)
Next
end if
Next

--
Regards,
Tom Ogilvy

"ron_dallas" wrote in message
oups.com...
This is getting the best of me, :(

I have S/S with multi worksheets with system and hardware layout. The
problem is it is all done from left to right. I need to find just the
system and write them top to bottum and which tab they were found on a
new worksheet.

So something like this:
1) create new worksheet called systems.
2) goto first worksheet
3) find first row with system in column A
4) copy rest of row (B-AA) to worksheet systems and paste top to bottom
in Column A
5) go back to first worksheet find next system, if not anymore go to
next worksheet.

Any suggestions?

Thanks,
Ron

Find, Copy and change from row to column
 

Looks like it goes and finds them, but puts everything in A1

Let me change it and say copy what every it find to sheet systems, so
find a line, paste it, find next line paste it on the next line. Would
that be easier?

Find, Copy and change from row to column
 

Just left out the rw increment

On Error Resume Next
Worksheets.Add( After:=Worksheets(Worksheets.count)).Name = "System"
On Error goto 0
rw = 1
for each sh in Worksheets
if sh.Name < "System" then
set rng = sh.Columns(1).Specialcells(xlConstants)
for each cell in rng
cell.resize(1,27).copy Destination:=Worksheets("System").Cells(rw,1)
rw = rw + 1
Next
end if
Next

--
Regards,
Tom Ogilvy


"ron_dallas" wrote in message
oups.com...
Looks like it goes and finds them, but puts everything in A1

Let me change it and say copy what every it find to sheet systems, so
find a line, paste it, find next line paste it on the next line. Would
that be easier?