Private Sub Workbook_Open()
    Call TikTak
End Sub

Public Sub TikTak()
    Dim a As Range, b As Range
    
    On Error Resume Next
    Set a = ThisWorkbook.Sheets("Sheet1").Range("A1")
    Set b = ThisWorkbook.Sheets("Sheet1").Range("B6000").End(xlUp) 'posl riadok
    If b.Text <> "" Then Set b = b.Offset(1, 0)
    b.Value = a.Value

    DalsiTik = Now + TimeSerial(0, 0, 10) 'kazdych 10 sekund    
    Application.OnTime DalsiTik, "TikTak"
End Sub

Sub Rotuj_b1az10(xLstTime As Variant)
Dim rng As Range, f As Range, c As Range, mx As Variant

    On Error GoTo xErr
    Set rng = Sheet1.Range("B1:B10")
    Set c = rng.Cells(1)    'B1
    mx = (Application.WorksheetFunction.Max(rng))
    
    If mx <> 0 Then
        Set f = rng.Find(What:=CDate(mx), LookIn:=xlFormulas, LookAt:=xlWhole)
    
        If Not f Is Nothing Then
            If f.Row < 10 Then Set c = f.Offset(1, 0)
        End If
    End If
    c.Value = xLstTime
    Exit Sub
xErr:
    MsgBox Err.Description
End Sub