I want to prevent fill and drag in Excel

I want a VBA code to prevent fill and drag in an Excel sheet without hiding the fill and drag cruiser. and without preventing them from advanced settings.

In addition, I want this code to be localized to a certain sheet not to the whole workbook or new excel Documents.

It is preferred that if the user try to drag a message appears saying the action is not allowed, and the code undo any dragged/filled data.

The code must not affect single/multiple delete or copy data.

Can any one help me on that?

I tried many codes but non of them can do what i mentioned perfectly.

Below is my final tried code, but it is clunky.

Option Explicit

Private oldAddress As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next

    ' Prevent drag fill by breaking the selection extension
    If oldAddress = Selection.Address Then
        Exit Sub
    End If
    
    oldAddress = Selection.Address
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo exitsafe
    If Application.EnableEvents = False Then Exit Sub
    Application.EnableEvents = False

    ' --- Detect autofill drag (Excel always delivers big block change)
    If Target.Cells.CountLarge > 1 And Application.CutCopyMode = False Then
        Application.Undo
        MsgBox "Drag Fill is disabled on this sheet.", vbExclamation
        GoTo exitsafe
    End If

    ' ===== باقي كودك كامل بدون أي حذف =====
    
    Dim lastRow As Long
    Dim c As Range
    Dim rng As Range
    Dim rngRow As Range
    Dim modTime As String

    lastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row

    If Not Intersect(Target, Me.Cells(lastRow, "B")) Is Nothing Then
        Me.Unprotect Password:="#TPOzada@54EEcd#"
        Me.Range("BC1").Value = Now()
        Me.Protect Password:="#TPOzada@54EEcd#", UserInterfaceOnly:=True, AllowFiltering:=True
    End If

    For Each c In Target
        If HasValidationList(c) Then
            If Len(c.Value) > 0 Then
                If Not IsValidValue(c) Then
                    Application.Undo
                    MsgBox "Invalid entry in " & c.Address & _
                           ". Please select a value from the dropdown.", vbExclamation
                    GoTo exitsafe
                End If
            End If
        End If
        
        If Not Intersect(c, Me.Range("I:I,J:J,L:L,O:O")) Is Nothing Then
            If Len(c.Value) > 0 Then
                If Not IsNumeric(c.Value) Then
                    Application.Undo
                    MsgBox "Invalid numeric entry in " & c.Address & ". Only numbers are allowed.", vbExclamation
                    GoTo exitsafe
                End If
            End If
        End If
    Next c

    Set rng = Intersect(Target, Me.Range("A3:P999"))
    If Not rng Is Nothing Then
        modTime = Format(Now(), "dd/mm/yyyy")
        Me.Unprotect Password:="#TPOzada@54EEcd#"
        For Each rngRow In rng.Rows
            Me.Cells(rngRow.Row, "Q").Value = modTime
        Next rngRow
        Me.Protect Password:="#TPOzada@54EEcd#", UserInterfaceOnly:=True, AllowFiltering:=True
    End If

    Call RefreshPivotsAndSortBlanks

exitsafe:
    Application.EnableEvents = True
End Sub

' ===== Validation Helpers =====

Private Function HasValidationList(cell As Range) As Boolean
    On Error Resume Next
    HasValidationList = False
    If Not cell.Validation Is Nothing Then
        If cell.Validation.Type = xlValidateList Then HasValidationList = True
    End If
End Function

Private Function IsValidValue(cell As Range) As Boolean
    Dim f As String
    On Error Resume Next
    IsValidValue = True
    f = cell.Validation.Formula1
    If f <> "" Then
        IsValidValue = Not IsError(Application.Match(cell.Value, Evaluate(f), 0))
    End If
End Function