VBA routine debug question

[H28Sailor]

I have the following code:-

Sub CopyRows()
' copy all rows of data in worksheet 'temp' to the appropriate worksheets
    Dim iLooper As Long, NextRow As Long, ws As Worksheet, strSheet As String
    With Worksheets("temp")
        For iLooper = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            If UCase(Trim(.Cells(iLooper, "B").Value)) Like "ENROLLMENT*" Then
                strSheet = "ENROLLMENT"
            ElseIf UCase(Trim(.Cells(iLooper, "B").Value)) Like "WEEK*" Then
                strSheet = .Cells(iLooper, "a").Text
            Else
                strSheet = ""
            End If
            If strSheet <> "" Then
                Set ws = Worksheets(strSheet)
                NextRow = ws.Columns("B").Find("*", , xlValues, , 1, 2).Row + 1
                ws.Rows(NextRow).Insert
                ws.Cells(NextRow, "A").Resize(, 8).Value = _
                    .Cells(iLooper, "A").Resize(, 8).Value
            End If
        Next
    End With
' delete all rows of data in worksheet 'temp'
Dim r As Long
For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
  If Cells(r, 1) = "" Then Rows(r).Delete
Next r
End Sub

When run I get a run-time error '9': Subscript out of range together with the line Set ws = Worksheets(strSheet) above highlighted

The routine processes all the lines as they should be - and so the error occurs at the end of processing and, of course, the lines of data in 'temp' are not erased

Would welcome any comments on how to correct the code..........

Bob M