Loop error

Try this.

Sub Create_Tabs()
Dim Findrow As Range
Dim strName As String
Dim RowNum As Long
Dim I As Long

    With Sheets("QP")
    
        Set Findrow = .Range("B:B").Find(What:="Total Hours", LookIn:=xlValues)
        
        RowNum = Findrow.Row - 1

        For I = 4 To RowNum
            strName = .Cells(I, 2).Value
            Sheets("Do Not Delete").Copy Before:=Sheets("Do Not Delete")
            Sheets("Do Not Delete (2)").Name = strName
        Next I
        
    End With
    
End Sub