Dim application,sh,rng
Set application = GetObject(,"excel.application")
Set sh = application.activesheet
set rng = application.selection
cols = rng.columns.count
If cols = sh.columns.count Then Set rng = application.intersect(rng,sh.usedrange)
r = rng.row
k = sh.rows.count
For i = 1 To cols
If sh.cells(1,rng(1,i).column) <> "" Then
k = 1
else
j = sh.cells(1,rng(1,i).column).end(4).row
If j <= r And j<k Then k = j
End If
Next
If k <> sh.rows.count Then sh.range(rng.offset(k - r),rng).select
Set application = Nothing
Set sh = nothing
set rng = nothing