Any Idea why this only works for the First Worksheet (Hardware)?


Sub DupSheets()

Dim myWorkseheets(11) As String
Dim SAVESTR(11) As String
Dim iCount As Integer
Dim myRange As Range
Dim cell As Range
Dim delRange As Range
SAVESTR(1) = Worksheets("Sheet1").Range("B2").Value
SAVESTR(2) = Worksheets("Sheet1").Range("B3").Value
SAVESTR(3) = Worksheets("Sheet1").Range("B4").Value
SAVESTR(4) = Worksheets("Sheet1").Range("B5").Value
SAVESTR(5) = Worksheets("Sheet1").Range("B6").Value
SAVESTR(6) = Worksheets("Sheet1").Range("B7").Value
SAVESTR(7) = Worksheets("Sheet1").Range("B8").Value
SAVESTR(8) = Worksheets("Sheet1").Range("B9").Value
SAVESTR(9) = Worksheets("Sheet1").Range("B10").Value
SAVESTR(10) = Worksheets("Sheet1").Range("B11").Value
SAVESTR(11) = Worksheets("Sheet1").Range("B12").Value
myWorkseheets(0) = "Sheet1"
myWorkseheets(1) = "Hardware"
myWorkseheets(2) = "Hardware (2)"
myWorkseheets(2) = "Hardware (3)"
myWorkseheets(2) = "Hardware (4)"
myWorkseheets(2) = "Hardware (5)"
myWorkseheets(2) = "Hardware (6)"
myWorkseheets(2) = "Hardware (7)"
myWorkseheets(2) = "Hardware (8)"
myWorkseheets(2) = "Hardware (9)"
myWorkseheets(2) = "Hardware (10)"
myWorkseheets(11) = "Hardware (11)"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Windows("9006 Port Report.xls").Activate
For iCount = 0 To 11
Worksheets(myWorkseheets(iCount)).Select
Worksheets(myWorkseheets(iCount)).Columns("I:I").S elect
On Error Resume Next
Selection.Find(What:=SAVESTR(iCount), After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
If Err.Number < 91 And Err.Number < 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row 1 Then
Set myRange =
Worksheets(myWorkseheets(iCount)).Range("I1").Resi ze(Range( _
"I" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value < SAVESTR(iCount) Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
Worksheets(myWorkseheets(iCount)).Range("B1").Sele ct
Selection.EntireRow.Insert
Worksheets(myWorkseheets(iCount)).Range("N1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("O1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("P1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("Q1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("R1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("S1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("T1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("U1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("V1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("W1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Else
Columns("A:A").ColumnWidth = 2
End If
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
ChDir "C:\Temp Data Files\Reconfigured Data"
ActiveWorkbook.SaveAs Filename:="C:\Temp Data Files
\Reconfigured Data\9006 Port Report.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Sheets("Hardware").Select
Next iCount
Application.ScreenUpdating = False
End Sub


Your assistance is really appreciated.