Sélection automatique sur recherche

Option Explicit

Sub RechercheColA()
'
Dim Cell As Range
Dim Plage As Range
Dim PremAdresse$
'
  With ActiveSheet.Range('A:A')
    Set Cell = .Find(what:='C', LookIn:=xlValues, lookat:=xlWhole)
    If Not Cell Is Nothing Then
      PremAdresse = Cell.Address
      Set Plage = Range(Cells(Cell.Row, 1), Cells(Cell.Row, 4))
      Set Cell = .FindNext(Cell)
      Do While Not Cell Is Nothing And PremAdresse ‹› Cell.Address
        Set Plage = Union(Plage, Range(Cells(Cell.Row, 1), Cells(Cell.Row, 4)))
        Set Cell = .FindNext(Cell)
      Loop
      Plage.Select
    End If
  End With
End Sub

Cliquez pour agrandir...