try
Private a()
Sub test()
Dim wb As Workbook, ws As Worksheet, r As Range, ff As String, n
On Error Resume Next
x = UBound(a, 2)
If Err.Number <> 0 Then
On Error GoTo 0
For Each wb In Workbooks
For Each ws In wb.Sheets
Set r = ws.Cells.Find(50, , , xlPart)
If Not r Is Nothing Then
ff = r.Address
Do
n = n + 1
ReDim Preserve a(1 To 4, 1 To n)
a(1, n) = wb.Name: a(2, n) = ws.Name
a(3, n) = r.Address(0, 0)
Set r = ws.Cells.FindNext(r)
Loop Until ff = r.Address
End If
Next
Next
End If
For i = 1 To UBound(a, 2)
If IsEmpty(a(4, i)) Then
With Workbooks(a(1, i))
.Activate
With .Sheets(a(2, i))
.Activate
.Range(a(3, i)).Select
End With
End With
a(4, i) = "n/a"
flag = True
Exit For
End If
Next
If Not flag Then MsgBox "No more"
End Sub