Sub Vyber_Oblasti()
Dim R As Long, i As Long, Zac As Long, Kon As Long, PKon As Long, Data(), Cisla(), ZACIATOK As String, KONIEC As String

Const STLPEC_URCUJUCI_RIADKY = "D"
Const STLPEC_CISEL = "B"
Const PRVY_RIADOK = 6
Const STLPCE = "A:H"

ZACIATOK = "hrusky"
KONIEC = "jahody"

With ThisWorkbook.Worksheets("Sheet1")
R = .Cells(Rows.Count, STLPEC_URCUJUCI_RIADKY).End(xlUp).Row - PRVY_RIADOK + 1

Select Case R
Case Is < 1: MsgBox "Žiadne data v stĺpci " & STLPEC_URCUJUCI_RIADKY, vbCritical: Exit Sub
Case 1: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Cells(PRVY_RIADOK, STLPEC_URCUJUCI_RIADKY).Value2
ReDim Cisla(1 To 1, 1 To 1): Cisla(1, 1) = .Cells(PRVY_RIADOK, STLPEC_CISEL).Value2
Case Else: Data = .Cells(PRVY_RIADOK, STLPEC_URCUJUCI_RIADKY).Resize(R).Value2
Cisla = .Cells(PRVY_RIADOK, STLPEC_CISEL).Resize(R).Value2
End Select

On Error Resume Next
Zac = WorksheetFunction.Match(ZACIATOK, Data, 0)
If Err.Number <> 0 Then MsgBox "Začiatok oblasti nebol nájdený : " & ZACIATOK, vbCritical: Exit Sub
PKon = WorksheetFunction.Match(KONIEC, Data, 0)
If Err.Number <> 0 Then MsgBox "Koniec oblasti nebol nájdený : " & KONIEC, vbCritical: Exit Sub
On Error GoTo 0

For i = 1 To R - PKon
If IsEmpty(Cisla(PKon + i, 1)) Then Kon = PKon + i - 1: Exit For
Next i

Kon = IIf(Kon = 0, R, Kon)
.Range(STLPCE).Resize(Kon - Zac + 1).Offset(PRVY_RIADOK + Zac - 2).Select
End With
End Sub
Variant 2:

Sub Vyber_Oblasti_2()
Dim Zac As Range, Kon As Range, tmp As Range, ZACIATOK As String, KONIEC As String


Const ZLUCENE_STLPCE_URCUJUCE_RIADKY = "D:F"
Const STLPEC_CISEL = "B"
Const STLPCE = "A:H"


ZACIATOK = "hrusky"
KONIEC = "jahody"

With ThisWorkbook.Worksheets("Sheet1")
On Error Resume Next
Set Zac = .Range(ZLUCENE_STLPCE_URCUJUCE_RIADKY).Find(What:= ZACIATOK, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Err.Number <> 0 Or Zac Is Nothing Then MsgBox "Začiatok oblasti nebol nájdený : " & ZACIATOK, vbCritical: Exit Sub
Set Kon = .Range(ZLUCENE_STLPCE_URCUJUCE_RIADKY).Find(What:= KONIEC, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Err.Number <> 0 Or Kon Is Nothing Then MsgBox "Koniec oblasti nebol nájdený : " & KONIEC, vbCritical: Exit Sub

If Kon.Row < Zac.Row Then Set tmp = Kon: Set Kon = Zac: Set Zac = tmp

Set Kon = .Columns(STLPEC_CISEL).Find(What:="", After:=.Columns(STLPEC_CISEL).Cells(Kon.Row, 1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Offset(-1, 0)

.Range(STLPCE).Resize(Kon.Row - Zac.Row + 1).Offset(Zac.Row - 1).Select
On Error GoTo 0
End With
End Sub

Jeee

Ďakujeemm,, veľmi prínosné pre mňa, na tom sa dá stavať

veľká vďakaaa

Len som zle napísal zadanie, musím nejako upraviť konštantu, prvý riadok nebude stále 6, nad "hruskami" bude rôzny počet riadkov, musíme to vystavať trošku inak.
Škoda že som na to v popise nemyslel.. pardon
skúsil som Const PRVY_RIADOK = Cells.Find("hrusky") ale to nefunguje

Ďakujem veľmi pekne, verzia_2 funguje perfektne, síce celkom nerozumiem ako ale študujem to.
Ja by som to nedokázal takto nikdy napísať, to chce lepšiu hlavičku..
Ďakujem ešte raz veľmi pekne, zostávam dlžníkom..
Edit:
aa už mi trošku dochádza.. hľadaj..čo.. Začiatok, Začiatok = "hrusky" šikovné, dakujeemm, veľmi pekne si to rozpísal, teraz si ešte dorobím kopírovanie vybranej oblasti do nového listu a do nového zošita, iste to nebude také profi pekné učesané ako Tvoje makierko ale hádam fungovať bude,

Ďakujem ešte raz a zas a zas,