I would probably have written this differently (without arrays), but here is
a modification of what you have.

Option Explicit
Sub CreateaMain()
Dim ShtNames()
Dim lastRow As Long
Dim ShtNum As Long
Dim RowCount As Long
Dim aWB As Workbook
Dim myWS As Worksheet
Dim Sht As Worksheet
Dim c As Range
Dim Phonenum As String
Dim ShtNames(6) As String
Set aWB = ThisWorkbook
Set myWS = aWB.Sheets("Phones_Analysis_9-2008")

ShtNames() = Array("May 08_478156199", "May 08_4614445456", _
"June08_478156199", "June 08_461445456", "July 08_478156199", "July
08_461445456")

With myWS
lastRow = .Range("F" & Rows.Count).End(xlUp).Row
For ShtNum = LBound(ShtNames) To UBound(ShtNames)
Set Sht = aWB.Worksheets(ShtNames(ShtNum))
For RowCount = 1 To lastRow
Phonenum = Sht.Range("F" & RowCount)
Set c = Sht.Columns("A").Find(what:=Phonenum, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Sht.Cells("B" & RowCount).Offset(0, ShtNum) = _
Sht.Range("P" & c.Row)
End If
Next RowCount
Next ShtNum
End With
End Sub




--
HTH,
Barb Reinhardt




"Jane Doe" wrote:

Runtime 13....type (mismatch error)

Sub CreateaMain()

ShtNames = Array("May 08_478156199", "May 08_4614445456", "June
08_478156199", "June 08_461445456", "July 08_478156199", "July 08_461445456")
With Sheets("Phones_Analysis_9-2008")
LastRow = .Range("F" & Rows.Count).End(xlUp).Row
For ShtNum = LBound(ShtNames) To UBound(ShtNames)
Set Sht = Sheets(ShtNames(ShtNum))
For RowCount = 1 To LastRow
PhoneNum = .Range("F" & RowCount)
Set c = Sht.Columns("A").Find(what:=PhoneNum, _
LookIn:=xlValues, lookat:=xlWhole)
Error If Not c Is Nothing Then
.Cells("B" & RowCount).Offset(0, ShtNum) = _
Sht.Range("P" & c.Row)
End If
Next RowCount
Next ShtNum
End With
End Sub


Thanks. Got this from user and waiting on reply...anyone help in the meantime?