Altid starte i toppen

Hej Jeg har et lille problem med understående formel
Hvis jeg har søgt på et navn hvor der er mange linier i og jeg bliver nød til at scrolle for at komme til den sidste , så hvis jeg søger på et andet navn hvor der ikke er mange linier , så skal jeg scrolle op igen
Jeg ville gerne hvis den selv startede i toppen af de fundne linier, hvis der søges på et nyt navn
kan man det ?



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Dim x, y, z, a As Integer
z = Application.WorksheetFunction.CountA(Sheets("Ark2").Range("A:A"))
Sheets("Ark5").Range("B:O").ClearContents
y = 2
For x = 1 To z
If UCase(Sheets("Ark2").Cells(x, 1)) = UCase(Sheets("Ark5").Range("A1")) Then
Worksheets("Ark2").Range("B" & x & ":O" & x).Copy _
    Destination:=Worksheets("Ark5").Range("B" & y)
y = y + 1
End If
Next
End If
End Sub