Makro - na vyhledávání a přepisování

[rotshield]

Ahoj,
chtěl bych vás poprosit o pomoc. Snažím se vytvořit v excelu makro na vyhledávání a přepisování, ale jsem úplný žačátečník a nedostanu se přes první krok.
Potřeboval bych, aby makro sáhlo do "List 2" buňky A1 tu vyhledalo v "List 1" a nahradilo jí položkou z "List 2" buňkou A2, atd. až do poslední buňky, která je vyplněná na "List 2" ve sloupci A.

Bohužel jsem se dostal pouze k tomuto, a nechce se mi to kopírovat až do poslední buňky ručně, nejde to nějak urychlit?

Sub Najdianahraď()
'
' Najdianahraď Makro
'

'
Sheets("List2").Select
Range("A1").Select
Selection.Copy
Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List1").Select
Cells.Replace What:="Free", Replacement:="Zdarma", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("List2").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List1").Select
Cells.Replace What:="Product", Replacement:="Produkt", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End Sub

Děkuji mnohokrát za info
Jirka

[Reklama]

[cmuch]

Něco takového?
Vlož do modulu Listu1
Popřípadě si uprav dle svého, páč nechápu jak máš ty buňky.
Takže hledám A1 a nahrazuji A2, pak hledám A3 a nahrazuji A4.....

Kód: Vybrat vše

Sub Najdianahrad()

  Dim radek As Long
  Dim zdrSh As Worksheet
  Application.ScreenUpdating = False

  Set zdrSh = Sheets("List2")
 
  'opakuj pro vsechny radky
  For radek = 1 To zdrSh.Cells(zdrSh.Cells.Rows.Count, "A").End(xlUp).Row
   
     Sheets("List1").Cells.Replace What:=zdrSh.Cells(radek, "A").Value, Replacement:=zdrSh.Cells(radek + 1, "A").Value, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
     radek = radek + 2
  Next radek
  Application.ScreenUpdating = True
End Sub