Delete Row based on Cell value in Multiple Sheet

Added lines are marked with added

Sub RectangleRoundedCorners10_Click()
    Dim rng As Range
    Set rng = Range("a9:zz2000")
    Do
        Set a = rng.find("Delete*", LookIn:=xlValues)
        If Not a Is Nothing Then
            todel = a.Row                             'added
            a.EntireRow.Delete
            Worksheets("Sheet2").Rows(todel).Delete   'added
            Worksheets("Sheet3").Rows(todel).Delete   'added
        End If
    Loop While Not a Is Nothing
    End Sub

Delete Rows in Multiple Sheets Based on Cell Value in the First

Sub RectangleRoundedCorners10_Click()
    
    ' Define constants.
    
    Const DST_SHEETS As String = "Sheet1,Sheet2,Sheet3"
    Const DST_FIRST_CELL As String = "A9"
    Const CRITERIA_STRING As String = "Delete*" ' begins with
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Return the worksheet names in an array.
    
    Dim wsNames() As String: wsNames = Split(DST_SHEETS, ",")
    Dim UB As Long: UB = UBound(wsNames)
    
    ' Reference the first worksheet and range.
    
    Dim ws As Worksheet: Set ws = wb.Sheets(wsNames(0)) ' the first
    
    Dim rg As Range: ' the first
    
    With ws.UsedRange
        Set rg = ws.Range(ws.Range(DST_FIRST_CELL), .Cells(.Cells.CountLarge))
    End With
        
    ' All but the first range to an array.
    
    Dim nRanges() As Range: ReDim nRanges(0 To UB)
        
    Dim n As Long
        
    For n = 1 To UB ' the first (0) is 'rg'
        Set nRanges(n) = wb.Sheets(wsNames(n)).Range(rg.Address)
    Next n
        
    ' Define the union ranges array.
        
    Dim uRanges() As Range: ReDim uRanges(0 To UB)
    
    ' Combine the matching rows into the ranges in the union ranges array.
    
    Dim rrg As Range, r As Long
    
    For Each rrg In rg.Rows
        r = r + 1
        If IsNumeric(Application.Match(CRITERIA_STRING, rrg, 0)) Then
            If uRanges(0) Is Nothing Then
                Set uRanges(0) = rrg
                For n = 1 To UB
                    Set uRanges(n) = nRanges(n).Rows(r)
                Next n
            Else
                Set uRanges(0) = Union(uRanges(0), rrg)
                For n = 1 To UB
                    Set uRanges(n) = Union(uRanges(n), nRanges(n).Rows(r))
                Next n
            End If
        End If
    Next rrg
    
    ' Delete the ranges and inform.
    
    If uRanges(0) Is Nothing Then
        MsgBox "No rows deleted.", vbExclamation
    Else
        For n = 0 To UB
            uRanges(n).Delete xlShiftUp
        Next n
        MsgBox "Rows deleted.", vbInformation
    End If
            
End Sub

Please, try the next way. It will create a helper column and based on it, a filter will be applied and its (visible) rows, except the header, will be deleted. So, it should be fast enough even for huge ranges:

Sub RectangleRoundedCorners10_Click()
    Dim ws As Worksheet, rng As Range, delRng As Range, rngMark As Range, rngFilt As Range
    Dim strAddress As String, arrMark, latR As Long

    Set rng = Sheets("Sheet1").Range("A9:AA2000")
    ReDim arrMark(1 To rng.rows.count, 1 To 1) 'reDim the helper array keeping the markers
    
    arrMark(1, 1) = "Marker" 'Place the header in the array first row
    ' Search target cells in Sheet1
    Set delRng = rng.Find("Delete*", lookat:=xlWhole, _
        LookIn:=xlValues, SearchDirection:=xlNext)
    If Not delRng Is Nothing Then
        strAddress = delRng.address
        Do
            arrMark(delRng.row - rng.row + 1, 1) = "Del" 'place the marker in the right position
            Set delRng = rng.FindNext(delRng)
        Loop While delRng.address <> strAddress
    End If
    If strAddress <> "" Then
        ' Delete those rows in the next three sheets:
        For Each ws In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
            If ws.AutoFilterMode Then ws.AutoFilterMode = False 'remove the filter if it exists
            Set rngMark = ws.Range("AAA9") 'set the markers/helper column starting cell
            rngMark.Resize(UBound(arrMark), 1).Value2 = arrMark 'drop the array content at once
            ws.Range("A9:AAA" & UBound(arrMark)).AutoFilter rng.Columns.count + 1, "Del" 'auto filter by this column
            
            rng.Resize(rng.rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
            ws.AutoFilterMode = False
        Next ws
    End If
End Sub