Demo of a sub to loop the worksheets and to call your code depending on the sheet name (I just guesses)

I also cleaned your sub a little since you usually don't need to .Select first, and I wanted everything to be within the "With / End With" (the reason for the .Range() etc.)


Sub LoopTheWorksheets()
    Dim wsCheck As Worksheet
    
    For Each wsCheck In ActiveWorkbook.Worksheets
        If wsCheck.Name Like "DoThis*" Then
            If Not wsCheck.ProtectContents = False Then
                Call Fix_Sheet(wsCheck)
            End If
        End If
    Next
End Sub
 

Sub Fix_Sheet(ws As Worksheet)
    
    With ws
        .Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("E1").FormulaR1C1 = "Day"
        .Range("E2").FormulaR1C1 = "=TEXT(RC[-2],""ddd"")"
        .Range("E2").AutoFill Destination:=Range("E2:E5000")
    
        .Range("C1").FormulaR1C1 = "Date"
    
        .Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("F1").FormulaR1C1 = "Interval"
        .Range("F2").FormulaR1C1 = "=(RC[1]/24)+(RC[2]/1440)"
        .Range("F2").AutoFill Destination:=Range("F2:F5000")
        .Columns("F:F").NumberFormat = "[$-409]h:mm AM/PM;@"
     
        .Range("D1").FormulaR1C1 = "lookup"
        .Range("D2").FormulaR1C1 = "=RC[-1]&RC[2]"
        .Range("D2").AutoFill Destination:=Range("D2:D5000")
     
     
        .Range("A1").FormulaR1C1 = "WeekNum"
        .Range("A2").FormulaR1C1 = "=WEEKNUM(RC[+2])"
        .Range("A2").AutoFill Destination:=Range("A2:A5000")
        .Columns("A:A").NumberFormat = "#,##0"
    
        .Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    
End Sub

No test, but hopefully it will move you forward


Paul