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