Sub CopyData()
Dim sh as Worksheet
Dim sh1 as Worksheet
Dim i as long, rng as Range
Application.DisplayAlerts = False
On Error Resume Next
worksheets("Summary").Delete
On Error goto 0
Application.DisplayAlerts = True
set sh = worksheets.Add(after:=worksheets(worksheets.count) )
sh.Name = "Summary"
for each sh1 in Worksheets
if sh1.Name < sh.Name then
lastrow = sh1.cells(rows.count,7).End(xlup).row
for i = 2 to lastrow
if isnumeric(sh1.Cells(i,"G").Value) then
if sh1.cells(i,"G").Value = 1 then
set rng = sh.cells(rows.count,7).End(xlup)(2,-5)
sh1.Cells(i,"G").EntireRow.copy Destination:=rng
end if
end if
Next
End if
Next
End Sub

--
Regards,
Tom Ogilvy


wrote in message
oups.com...
Hello All,


I am using Office 2003/Windows XP and have a workbook with many sheets
(50+).
I wish to extract the rows from all the sheets in Column G, where the
value is equal to 1 or greater than 1.

Following is the sample sheet.. Data is not consistent.. I wish to copy
the complete row to a New Worksheet one below other from Sheet1 to the
end 50+ sheets.


A B C D E F G H

1 Data Data Data 0 Data
2 Data Data 1
3 blank row
4 blank row
5 Data Data 0
6 Data 2 Data
...
...
....
Last Data is in Row No. 65

Is this possible thru VBA.

Any help would be greatly appreciated.

Thanks in advance

Ashish Kumar