MS Excel

-- Mé makro

Sub test()

Dim wsData As Worksheet
Dim wsForm As Worksheet
Dim sFirstFound As String, rList As Range, rLookFor As Range
Dim result As Range, LR As Long
' DEFINOVANI LISTU
Set wsData = ThisWorkbook.Worksheets("data")
Set wsForm = ThisWorkbook.Worksheets("form")
' DEFINOVANI DB JMEN
Set rList = wsData.Range("A1:A" & wsData.Cells(Rows.Count, 1).End(xlUp).Row)
' DEFINOVANI OBLASTI CO HLEDAT
Set rLookFor = wsForm.Range("H2:H150")

' ZJISTENI POSLEDNI POUZITE RADKY VE SLOUPCI "A" V LISTE FORM
LR = wsForm.Range("A" & Rows.Count).End(xlUp).Row
' KDYZ BUDE VETSI NEZ 3, JE TREBA OBLAST VYMAZAT
If LR > 3 Then
wsForm.Range("A4:D" & LR).ClearContents
End If

' VYHLEDANI JMENA V DB JMEN
Set result = rList.Find(rLookFor.Value)

If Not result Is Nothing Then
' POKUD JE JMENO NALEZENO ULOZ POZICI DO RETEZCE
sFirstFound = result.Address
Do
' DEFINOVANI PRVNI VOLNE RADKY V LISTU FORM
LR = wsForm.Range("A" & Rows.Count).End(xlUp).Row + 1
' PRENESENI VYHLEDANYCH DAT NAT POZADOVANOU RADKU
wsForm.Range("A" & LR).Resize(1, 4) = result.Resize(1, 4).Value
' POKRACOVANI HLEDANI DALSIHO VYSKYTU OD POZICE POSLEDNIHO VYSKYTU
Set result = rList.FindNext(result)
' OPAKUJ CYKLUS "DO" DOKUD JE VYRAZ VYHLEDAN A JEHO POZICE JE JINA NEZ PRVNI ULOZENA
Loop While Not result Is Nothing And result.Address <> sFirstFound
End If
End Subcitovat

Funguje perfektně, děkuji za pomoc.citovat