Acele oldu iş dolayısıyla ama çalıştı.Deneyip olmayan kısımları tamamlayabilirsiniz isterseniz.
Sub FormatliAra(ByVal txtAranan As String)
Dim RngAra As Range
Dim RngSonuc As Range
Dim RngBul As Range
Dim RngBul2 As Range
Dim RngBul3 As Range
Dim RngBulSon As Range
Dim Cll As Range
Dim Sht As Worksheet
Dim Sht2 As Worksheet
Set Sht = ThisWorkbook.Worksheets("Arama")
Set Sht2 = ThisWorkbook.Worksheets("IVL")
Set RngAra = Sht2.Range("A:A")
' Clear previous formats and set new format
Application.FindFormat.Clear
Application.FindFormat.Font.Bold = True 'formatly arama için gerekli kod
With Sht
Set RngBul = RngAra.Find(txtAranan, SearchFormat:=True)
SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
.Range("C2:x" & SonStr).ClearContents 'Arama Sayfasyny bo?altan kod
If RngBul Is Nothing Then Exit Sub 'veri yoksa i?lemi iptal etme
Set RngAra = Sht2.Range("A" & RngBul.Row & ":A" & RngBul.Row + 100)
Set RngBulSon = Sht2.Range("A:A").Find("IVL No", , , , , xlPrevious, , SearchFormat:=True)
Set RngBul3 = Sht2.Range("A:A").Find(txtAranan, SearchFormat:=True)
Sht.Range("C2:XFD" & Rows.Count).Clear
If RngBul3.Row - 1 = RngBulSon.Row Then
SonStr = Sht2.Cells(.Rows.Count, "A").End(xlUp).Row
Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":L" & SonStr)
RngSonuc.Copy Sht.Range("C2")
GoTo var
End If
Set RngBul2 = RngAra.Find("IVL No", SearchFormat:=True)
Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":L" & RngBul2.Row - 1)
RngSonuc.Copy Sht.Range("C2")
var:
SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
.Range("C" & SonStr & ":N" & SonStr).Merge
.Range("C2:N" & SonStr).BorderAround Weight:=xlThin
End With
Application.FindFormat.Clear
End Sub
