Option Explicit

Sub Kopiruj_TEREZU()
Dim Oblast As Range
Dim Radek As Range
Dim Bunka As Range
Dim KopirovanaOblast As Range

Set Oblast = List1.UsedRange

For Each Radek In Oblast.Rows
    For Each Bunka In Radek.Cells
        If Bunka.Value = "Tereza" Then
            If KopirovanaOblast Is Nothing Then
                Set KopirovanaOblast = Bunka.EntireRow
                Exit For
            Else
                Set KopirovanaOblast = Union(KopirovanaOblast, Bunka.EntireRow)
                Exit For
            End If
        End If
    Next Bunka
Next Radek

If Not KopirovanaOblast Is Nothing Then
    KopirovanaOblast.Copy List2.Range("A1")
    If ActiveSheet.CodeName = "List1" Then List1.Range("A1").Select
    MsgBox "Kopírování dokončeno.", vbInformation, "Hotovo"
Else
    MsgBox "Žádná data ke kopírování.", vbExclamation, "Varování"
End If

Set Oblast = Nothing
Set KopirovanaOblast = Nothing
Set Bunka = Nothing
End Sub