Sub FindNumbers()
strColumn = "A"
intStartRow = 1
Set objLastSheet = Sheets(Sheets.Count)
For intRow = intStartRow To objLastSheet.Cells(65536, strColumn).End(xlUp).Row
strValue = objLastSheet.Cells(intRow, strColumn).Value
strFoundSheet = ""
For intSheet = 1 To Sheets.Count - 1
Sheets(intSheet).Activate
Set objCell = Cells.Find(What:=strValue, After:=Sheets(intSheet).Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not objCell Is Nothing Then
strFoundSheet = Sheets(intSheet).Name
Exit For
End If
Next
If strFoundSheet <> "" Then
objLastSheet.Cells(intRow, strColumn).Offset(0, 1).Value = strFoundSheet
Else
objLastSheet.Cells(intRow, strColumn).Offset(0, 1).Interior.Color = 255
End If
Next
objLastSheet.Activate
End Sub
|