Sub toto()
Dim m&, i&, j&, k&, p As Range
With [A1].Cells
m = Cells(Rows.Count, .Column).End(xlUp).Row
If m <= .Row Then
If .Value <> "" Then Set p = .Cells Else MsgBox "Rien !": Exit Sub
Else
For i = m To .Row Step -1
If Cells(i, .Column).Value = "" Then
j = i - (i < m)
If j < m Then
If p Is Nothing Then
Set p = Range(Cells(j, .Column), Cells(k, .Column))
Else
Set p = Union(Range(Cells(k, .Column), Cells(j, .Column)), p)
End If
End If
For k = i To .Row Step -1
If Cells(k, .Column) <> "" Then Exit For
Next
i = k
Else
If i = m Then k = m: Set p = Range(Cells(m, .Column), Cells(m, .Column))
End If
Next
If p Is Nothing Then Set p = Range(Cells(.Row, .Column), Cells(m, .Column))
If .Value <> "" And k <> 0 Then Set p = Union(Range(Cells(.Row, .Column), Cells(k, .Column)), p)
End If
End With
p.Select
End Sub