Mike,

Here's a shorter version

Sub LoadCells()
Const wsData As String = "Display Data"
Dim sh As Worksheet
Dim rng As Range
Dim oCell As Range
Dim iRow As Long
Dim sStart As String
Dim ary

ReDim ary(1, 0)

For Each sh In ActiveWorkbook.Worksheets

If sh.name < wsData Then

Set rng = sh.UsedRange

Set oCell = Nothing
Set oCell = rng.Find("#")
If oCell Is Nothing Then
MsgBox "No matches found on " & sh.name
Else
With sh
ReDim Preserve ary(1, iRow)
ary(0, iRow) = rng.Parent.name
ary(1, iRow) = oCell.Address(False, False)
iRow = iRow + 1
sStart = oCell.Address

Do
Set oCell = rng.FindNext(oCell)
If Not oCell Is Nothing And oCell.Address < sStart
Then
ReDim Preserve ary(1, iRow)
ary(0, iRow) = rng.Parent.name
ary(1, iRow) = oCell.Address(False, False)
iRow = iRow + 1
End If
Loop While Not oCell Is Nothing And oCell.Address <
sStart
End With

End If 'sh.Name < wsData

End If 'If not sh.Name

Next sh

If Not SheetExists(wsData) Then
Worksheets.Add(after:=Worksheets(Worksheets.Count) ). _
name = wsData
Else
Worksheets(wsData).Cells.ClearContents
End If

For iRow = LBound(ary, 2) To UBound(ary, 2)
Worksheets(wsData).Cells(iRow + 1, "A") = ary(0, iRow)
Worksheets(wsData).Cells(iRow + 1, "B") = ary(1, iRow)
Next iRow


End Sub

'-----------------------------------------------------------------
Function SheetExists(sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(sh) Is Nothing)
On Error GoTo 0
End Function



--

HTH

RP
(remove nothere from the email address if mailing direct)


"kinga" wrote in message
...
Hi,

Need some help writing some code to search a sheet's used cells for #'s,
save the cell reference and sheet name to an array and when its done, list
the array items into a blank workbook or a text file.
If anyone can help me with some snippets of code, it would be much
appreciated.

Thanks
Mike