That gets a bit tricky. You need to store the range in a static variable.
Here is some code that I use, which you can probalby adapt without too much
trouble...
*In a standard module****
Option Explicit
'***This code has the side effect that you can not copy on any sheet it is
run against
Public HighlightRow As clsHighlightRows
Public Sub Aut
pen()
Set HighlightRow = New clsHighlightRows
HighlightRow.AddSheet Sheet1
HighlightRow.AddSheet Sheet2
End Sub
Public Sub Auto_Close()
Set HighlightRow = Nothing
End Sub
*in a Class Module********
Option Explicit
Private HighlightSheets As New Collection
Private WithEvents xlApp As Excel.Application
Private rngOldTarget As Range
Private Sub Class_Initialize()
Set xlApp = Excel.Application
End Sub
Private Sub Class_Terminate()
Set xlApp = Nothing
Set HighlightSheets = Nothing
End Sub
Private Sub xlApp_SheetActivate(ByVal Sh As Object)
'Initialize the last cell to the current cell of this sheet
Set rngOldTarget = ActiveCell
'Highlight the Font of the current cell if necessary
Call xlApp_SheetSelectionChange(Sh, rngOldTarget)
End Sub
Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As
Range)
Dim wks As Worksheet
On Error Resume Next
Set wks = HighlightSheets.Item(Sh.Name)
On Error GoTo 0
If Not wks Is Nothing Then Call HighlightRow(Sh, Target)
End Sub
Public Function AddSheet(ByVal wks As Worksheet)
Call HighlightSheets.Add(wks, wks.Name)
End Function
Public Function RemoveSheet(ByVal wks As Worksheet)
Call HighlightSheets.Remove(wks.Name)
End Function
Public Property Get Items() As Collection
Set Items = HighlightSheets
End Property
Private Sub HighlightRow(ByVal Sh As Object, ByVal Target As Range)
If Not (rngOldTarget Is Nothing) Then
rngOldTarget.EntireRow.Interior.ColorIndex = xlNone
End If
'Set Last cell = Current cell
Set rngOldTarget = Target
Target.EntireRow.Interior.ColorIndex = 36
End Sub