Za prvé - to nalezení prvního prázdného řádku se dá efektně zkrátit na jediný příkaz (bez cyklu):

PrvniPrazdnyRadek = Range("A1").End(xlDown).Row + 1

A ty zadávané věci si přece můžeš prvně uložit do proměnné:

Zad_Jmeno = InputBox("Zadej Jméno:")
...

.. a pak je ukládat do buněk. Dále doporučuji vyhnout se konstrukcím ActiveCell+OFFSET, použij přímé adresování buněk CELL(řádek, sloupec):

Cell(PrvniPrazdnyRadek,1).Value = Zad_Jmeno
...