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" <ron_dallas2001@yahoo.com> wrote in message
news:1131132577.609687.164180@g47g2000cwa.googlegroups.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?
>
Bookmarks