Sub CopyData()
Dim sh as Worksheet
Dim sh1 as Worksheet
Dim i as long, rng as Range
Dim col as Long
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,8).End(xlup)(2,-6)
rng.Value = sh1.Name
col = sh1.Cells(i,"IV4").End(xltoLeft)
sh1.Range(sh1.Cells(i,"G"), _
sh1.Cells(i,col)).copy Destination:=rng(1,2)
end if
end if
Next
End if
Next
End Sub

--
Regards,
Tom Ogilvy


"prkhan56" wrote in message
oups.com...
WOW...Thanks Tom.
It works like a charm....but I am stumped with another problem...Is it
possible to have the respective sheet names in Column A and data from
the rows in Column B?.. Can you help please?

Thanks once again for your time and support.

Ashish Kumar