Try this macro and let me know


Sub PeopleSearch()
Dim W As Worksheet
Dim range_input, raange_input, b_range, e_range As Range
Dim VAL, sh_skip, temp, counter As Variant
sh_skip = "Summary" 'sheetname to skip
VALU = InputBox("Enter a week range (number of columns to be searched
through, ex. D7:F7)")
Set raange_input = Range(VALU)
VAL = InputBox("Enter which range to search in: (ex. D9:D62)")
Set range_input = Range(VAL)

For Each W In Worksheets
W.Select
counter = 0
For Each b_range In raange_input

If W.Name < "Summary" Then
temp = temp & Chr(10) & W.Name & Chr(10)
End If
For Each e_range In range_input
If W.Name < sh_skip Then
If counter = 0 Then
If Trim(W.Range(e_range.Address).Value) < "" And
Trim(W.Range(e_range.Address).Value) < "0" Then
temp = temp & W.Range("b" & e_range.Row).Value & Chr(10)
End If
Else
If Trim(W.Range(e_range.Address).Offset(counter, 0).Value) < ""
And Trim(W.Range(e_range.Address).Offset(counter, 0).Value) < "0"
Then
temp = temp & W.Range("b" & e_range.Row).Value & Chr(10)
End If
End If

End If
Next
counter = counter + 1
Next
Next

Workbooks.Add
Range("a1").Select
Selection.Value = "CURRENT PROJECTS LIST"
Selection.Font.Bold = True
temp1 = Split(temp, Chr(10))
Range("a2").Select
For i = 0 To UBound(temp1)
Selection.Value = temp1(i)
If Len(ActiveCell) 13 Or Not only_text(ActiveCell) Or
ActiveCell.Value = "RM UCONN SFA" Then
ActiveCell.Font.Bold = True
End If
ActiveCell.Offset(1, 0).Select
Next
Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:= _
"file", _
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
Workbooks.OpenText Filename:="file"
End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=386890