Hallo Andreas,

der bisherige Code hatte noch einen Gedankenfehler. Er berücksichtigte nur die aktivierte Zelle.

Nachfolgend mal ein Code, der jetzt wirklich beim Überfahren einer der gewünschten Zellen, den Mauscursor ändert. Bitte sicherstellen, dass der Timer beim Verlassen des Tabellenblattes und beim Schließen der Mappe abgeschaltet wird. Inwieweit die Funktionalität jetzt in jeder Lebenslage sicher ist, kann ich nicht sagen.

Option Explicit

Public Declare PtrSafe Function GetCursorPos Lib "user32" ( _
       lpPoint As POINTAPI) As Long
Public Declare PtrSafe Function SetTimer Lib "user32" ( _
       ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
       ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" ( _
       ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
        
Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Type RECT
  Left    As Long
  Top     As Long
  Right   As Long
  Bottom  As Long
End Type

Public iTimerID As LongPtr
Public hWnd     As LongPtr

Sub CheckMouseOverRange()
 Dim R As RECT, Pt As POINTAPI, AC As Object
 Dim iCur As Integer, i As Integer, sBer() As String
 
 sBer = Split("A1,C3,D5", ",")
 If iTimerID <> 0 Then KillTimer 0, iTimerID: iTimerID = 0
 iCur = xlDefault
 For i = 0 To UBound(sBer)
   Set AC = Range(sBer(i))
   With ActiveWindow.ActivePane
    On Error Resume Next
    R.Left = .PointsToScreenPixelsX(AC.Left)
    R.Top = .PointsToScreenPixelsY(AC.Top)
    R.Right = .PointsToScreenPixelsX(AC.Offset(0, 1).Left)
    R.Bottom = .PointsToScreenPixelsY(AC.Offset(1, 0).Top)
   End With
   
   GetCursorPos Pt
   If Pt.x > R.Left And Pt.y > R.Top And Pt.x < R.Right And Pt.y < R.Bottom Then
      iCur = xlNorthwestArrow: Exit For
    End If
    DoEvents
 Next i

 Application.Cursor = iCur
 If iTimerID = 0 Then iTimerID = SetTimer(0, 0, 100, AddressOf CheckMouseOverRange)
End Sub


'Ins Modul der Tabelle
Private Sub Worksheet_Activate()
  CheckMouseOverRange
End Sub

Private Sub Worksheet_Deactivate()
 If iTimerID <> 0 Then KillTimer 0, iTimerID: iTimerID = 0
End Sub

'In diese Arbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 If iTimerID <> 0 Then KillTimer 0, iTimerID: iTimerID = 0
End Sub

Private Sub Workbook_Open()
 If ActiveSheet.Name = "Tabelle1" Then CheckMouseOverRange
End Sub

viele Grüße

Karl-Heinz