Makro-ongelma tiedon haussa

pikkasen hakua peliin foorumilla ja kymmenkunta samantapaista casea ja mun vastaukset niihin löytyy...

muutaman rivin muokkauksella
taukoiden nimet nyt pohja ja valmiit ja haetaan A sarakkeesta vastineita

moduuliin...
Sub Siirrä()
Dim Löydetty As Range
Dim Solu As Range
Dim vika As Long

On Error Resume Next
Application.ScreenUpdating = False
Worksheets("valmiit").Activate
vika = Range("A65536").End(xlUp).Row
For Each Solu In Range("A1:A" & vika)
Solu.Offset(0, 4) = EtsiJaSiirrä(Solu, Range("pohja!A:A"))
Next Solu
Application.ScreenUpdating = True
End Sub


Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
Dim Solu As Range
Dim EkaOsoite As String

With HakuAlue
Set Solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not Solu Is Nothing Then
Set EtsiJaSiirrä = Solu.Offset(0, 3)
EkaOsoite = Solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, Solu)
Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address EkaOsoite
End If
End With
End Function