Sub sTxtCopy()
Dim WB as workbook
Dim rng as range
Set wb = workbooks.add
For s = 1 to thisworkbook.sheets.count
Set rng = thisworkbook.sheets(s).cells.specialcells(xlcelltypeconstants, 2)
For each c in rng
i = i +1
Wb.sheets(1).cells(i, "A") = c.value
Next c
Next s
End sub
Mfg