Se la vuoi leggermente più dinamica prova questa:

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim zona As Range
Dim ur As Long

If Target.Count > 1 Then Exit Sub

ur = Cells(Rows.Count, "A").End(xlUp).Row

Set zona = Range("A2:I" & ur)

If Not Intersect(Target, zona) Is Nothing Then

    If Target.Interior.ColorIndex <> 36 Then
        Cells(Target.Row, 1).Resize(1, zona.Columns.Count).Interior.ColorIndex = 36
    Else
        Cells(Target.Row, 1).Resize(1, zona.Columns.Count).Interior.ColorIndex = xlNone
    End If

End If

Set zona = Nothing

End Sub

in pratica se vuoi estendere la lunghezza del rigo oltre la colonna "I", ti basta modificare la variabile ZONA. Stesso discorso se vuoi ridurre la lunghezza.

Una domanda: che la riga selezionata resti evidenziata anche quando ne selezioni un'altra è una cosa voluta (dopo un po' avrai tutto evidenziato)?

frank_ciccio ha scritto:

Tolto la selezione delle righe sia poi evidenziata la riga attiva

Cosa significa "tolto la selezione"?

Mi spieghi passo-passo come selezioni più righe (mouse?, frecce?, menu?)

Ciao a tutti, approfitto della presenza di scossa per fargli vedere una mia problematica inerente al quesito. Usando questo VBA, visualizzo le righe RrI + RrF con valori giusti (posso selezionare diverse righe oppure selezionare una cella) però mi colora sempre una riga sotto e non capisco il motivo???

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim zona As Range
Dim ur As Long, RrI As Long, RrF As Long
ur = Cells(Rows.Count, "A").End(xlUp).Row
    Set zona = Range("A2:R" & ur)
    zona.Interior.ColorIndex = xlNone
    If Not Intersect(Target, zona) Is Nothing Then
        RrI = Target.Offset(0, 0).Row
        RrF = RrI + (Selection.Rows.Count - 1)
        zona.Rows(RrI & ":" & RrF).Interior.ColorIndex = 6
    End If
Set zona = Nothing
End Sub

Ciao @raffaele53,

provo a risponderti io   

Con il fatto che hai creato un range "zona" che va dal rigo 2 a ur allora per l'istruzione che hai scritto (zona.Rows(RrI & ":" & RrF).Interior.ColorIndex = 6)...se per caso selezioni il rigo 7, per il discorso di cui sopra, il settimo rigo risulta essere l'ottavo...perché il rigo 1 parte dal 2 (scusa il giro di parole). Per intenderci...se zona = Range("A4:R" & ur) ti ritroveresti 3 righe sotto.

In base alla variabile zona...io suggerisco di modificare il codice così:

zona.Rows(RrI - 1 & ":" & RrF - 1).Interior.ColorIndex = 6

Ciao, 

questa il codice che ho pensato per la tua esigenza:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rTable As Range, rRow As Range, nRows As Long
  
  If Sh.Name = "Foglio3" Then
    Set rTable = Intersect(Sh.UsedRange, Sh.UsedRange.Offset(3))
    If Not Intersect(Target, rTable) Is Nothing Then
      rTable.Interior.ColorIndex = xlNone
      For Each rRow In Selection.Areas
        With rRow
          Intersect(.EntireRow, rTable).Interior.ColorIndex = 8
        End With
      Next rRow
    End If
  Else
    Target.Calculate  '<<< per riga attiva colorata con formattazione
  End If

End Sub

Se .UsedRange eccede la tua tabella sostituisci 

Set rTable = Intersect(Sh.UsedRange, Sh.UsedRange.Offset(3))

con 

Set rTable = Intersect(Sh.UsedRange, Sh.Range("A4:L10000"))

dove 10000 è un valore a piacere purché maggiore del numero di righe previsto possa occupare in futuro la tabella

alexps81 ha scritto:

Ora ho notato che se tieni premuto contemporaneamente SHIFT + CTRL e click del mouse su una cella, allora la macro funziona. Però ti dico la verità...non so come mai e sinceramente la cosa di non saperlo non mi fa impazzire..

Ciao,

il problema nel tuo codice è qui:

    If GetKeyState(17) < 0 Then 'tasto ctrl
        Cells(Target.Row, 1).Resize(1, zona.Columns.Count).Interior.ColorIndex = 32
        Exit Sub
    End If

dove in  Cells(Target.Row, 1).Resize(1, zona.Columns.Count).Interior.ColorIndex = 32

fai riferimento a Target ma, se selezioni con ctrl premuto, Target resta sempre la prima cella che hai selezionato; ti basterà sostituire Target con ActiveCell e risolvi.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim zona As Range
Dim ur As Long

ur = Cells(Rows.Count, "A").End(xlUp).Row

Set zona = Range("A2:R" & ur)

If Not Intersect(Target, zona) Is Nothing Then

    If If GetKeyState(17) < 0 Then 'tasto ctrl
        Cells(ActiveCell.Row, 1).Resize(1, zona.Columns.Count).Interior.ColorIndex = 32
        Exit Sub
    End If

    If Target.Interior.ColorIndex <> 32 Then
        zona.Interior.ColorIndex = xlNone
        Cells(Target.Row, 1).Resize(1, zona.Columns.Count).Interior.ColorIndex = 32
    End If

End If

Set zona = Nothing

End Sub

N.B.: poiché in VBA True vale -1 l'istruzione If GetKeyState(17) < 0 Then può semplificarsi in If GetKeyState(17)  Then

scossa ha scritto:

ho usato l'evento Workbook_SheetSelectionChange

E per essere chiarissimi, quel codice va nel modulo di ThisWorkbook perche' e' un evento del Workbook (non di un foglio, ne' a se stante in un modulo di codice).