Makro je dobré vyhledává jak podle ID i Jména, ale pouze do 2 ID 3 už to nenajde.
Potřebuji to hledat i dál ne jen do 2 v datech.
Pokud Počet fotek je uvedeno číslo vyhledá to i 10000 ale pokud Počet fotek není tak to nevyhledá nic ani ID 1 nebo 2.
Mělo to vyhledat a pokud v dané buňce není záznam tak buňka má byt prázdná ať už se jedná počet fotek nebo datum ....

Sub Makro2()

Dim WsData As Worksheet, WsVyhl As Worksheet
Dim VyhlCo As String
Dim VyhlKde As Integer, VyhlSloupec As Integer
Dim VyhlRadek As Integer, AktRadek As Integer
Dim PocetFotek As Integer

Application.ScreenUpdating = False
Set WsVyhl = ThisWorkbook.Worksheets("Vyhledávání")
Set WsData = ThisWorkbook.Worksheets("Data")
VyhlCo = WsVyhl.Range("D2") ' Vyhledat co
VyhlKde = WsVyhl.Range("D3") ' Vyhledat kde (0 = ID, 1 = JMÉNO)

VyhlRadek = 0 ' Předpokládám, že nic nenaleznu
PocetFotek = 0 ' Počet fotek vynuluji
AktRadek = 4 ' Aktuální řádek v datech
WsData.Activate
If VyhlKde = 0 Then ' Vyhledání v poli ID
VyhlSloupec = 2
Else ' Vyhledání v poli JMÉNO
VyhlSloupec = 4
End If
Do
If VyhlCo = WsData.Cells(AktRadek, VyhlSloupec).Value Then
VyhlRadek = AktRadek ' Našel jsem shodu na aktuálním řádku
PocetFotek = WsData.Cells(AktRadek, 10).Value
Exit Do ' Končím cyklus
End If
AktRadek = AktRadek + 1 ' Není shoda, jdu na další řádek
Loop While AktRadek < 10000 ' Opakuji až do řádku 10 000

If (VyhlRadek > 0) And (PocetFotek > 0) Then ' Našel jsem, počet fotek je nenulový
WsData.Range(Cells(VyhlRadek, 2), Cells(VyhlRadek, 16)).Select ' Vyberu řádek
Else ' Nenalezeno, vyberu první (prázdný) řádek
WsData.Range(Cells(1, 2), Cells(1, 16)).Select
End If
Selection.Copy ' Vybraný řádek zkopíruji na vyhledávací list
WsVyhl.Activate
WsVyhl.Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
WsVyhl.Range("D2").Select
Application.ScreenUpdating = True

End Sub