Sub Duzenle()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim bul As Range
Dim Baslangic_Satir As Long
Dim Sh2SonSatir As Long
Dim adres As String
Dim i As Long
Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")
sh2.Range("A2:E" & sh2.Cells(65536, 1).End(xlUp).Row).ClearContents
Set bul = sh1.Columns(1).Find("Soyadi", , , xlPart)
If Not bul Is Nothing Then
adres = bul.Address
Do
Baslangic_Satir = bul.End(xlDown).Row + 1
For i = Baslangic_Satir To 65536
If IsEmpty(sh1.Cells(i, 1)) = True Then: Exit For
Sh2SonSatir = sh2.Cells(65536, 1).End(xlUp).Row + 1
With sh2
.Cells(Sh2SonSatir, 1) = bul.Offset(-1, 1)
.Cells(Sh2SonSatir, 2) = bul.Offset(0, 1)
.Cells(Sh2SonSatir, 3) = sh1.Cells(i, 1)
.Cells(Sh2SonSatir, 4) = sh1.Cells(i, 2)
.Cells(Sh2SonSatir, 5) = sh1.Cells(i, 3)
End With
Next i
Set bul = sh1.Columns(1).FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
Set sh1 = Nothing
Set sh2 = Nothing
Set bul = Nothing
End Sub