combination data from Multiple Worksheets into 1 Worksheet

[keldo]

Hi experts,

I have 40 sheets with same template which have A:H columns in a file
where col A is country,Col B is city and H is the population. Each
sheet named by the country. The data will be updated weekly. If I want
to find which city's population is greater than 10,000, how can I
extract the result into a new sheet so that it can be updated weeking
automatically?

 

[Tom Ogilvy]

Assume the results are placed in a worksheet named summary in the same
workbook.
Sub CopyData()
Dim rng as Range, cell as Range, cell1 as Range
Dim sh as Worksheet
Worksheets("Summary").UsedRange.EntireRow.delete
for each sh in ThisWorkbook.Worksheets
if lCase(sh.Name) <> "summary" then
set rng = sh.Range(sh.Cells(1,1),sh.Cells(1,1).End(xldown))
for each cell in rng
if cell.offset(0,7).Value > 10000 then
set cell1 = worksheets("Summary") _
.Cells(rows.count,1).End(xlup)(2)
cell.Entirerow.copy Destination:=Cell1
end if
Next
End if
Next
End Sub

Code is untested an may contain typos.

 

[keldo]

Ogilvy, It does work!!1 Thanks a lot. In advance, the country name i
cell A1 inside each sheet. and start from row 2, col A is city and co
H is population, in this time, I just want country, city and populatio
list in 'summary', how to modify the program

 

[Tom Ogilvy]

Sub CopyData()
Dim rng as Range, cell as Range, cell1 as Range
Dim sh as Worksheet
Worksheets("Summary").UsedRange.EntireRow.delete
for each sh in ThisWorkbook.Worksheets
if lCase(sh.Name) <> "summary" then
set rng = sh.Range(sh.Cells(2,1),sh.Cells(2,1).End(xldown))
for each cell in rng
if cell.offset(0,7).Value > 10000 then
set cell1 = worksheets("Summary") _
.Cells(rows.count,1).End(xlup)(2)
sh.Range("A1").copy Destination:=Cell1
cell.copy Destination:=Cell1.Offset(0,1)
cell.offset(0,7).Copy Destination:=cell.offset(0,2)
end if
Next
End if
Next
End Sub