AccessTr.neT

aklımdaydı ama unutmuşum eklemeyi; eğer girilen rakam son veriyse IVL bulunamayacağı için hata verecektir o nu da kontrol etmek gerek, bu durumda son satıra göre işlem yapılmalı

Abey pc yi kapattığım için deneyemedim.
Ayrıca IVL syfasındaki son ver arnırsa yani arama sayfası b2 ye IVL sayfasının son stırındaki numara aratılırsa bence hata olur çünkü IVL Sayfa diye birşey hücrede olmayacağı için.
Biraz karışık anlattım ama deneyince yazarım nasipse.

Berduş abey dediğimi denedim tahmin ettiğim gibi hata verdi.

IVL sayfasının 142 satırındaki veriyi(15.105.1106 ) aratırsanız bulmuyor halbuki var.
Onun için find ile tekrar bence şart eklenmeli.

@berduş hocam dedikleri alttaki kod ile halletim sizin kodda az değişiklik yapıp.
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

hocam kodu aşağıdaki gibi düzenleyince bir soruna rastlamadım
sadece son satırın yüksekliğini otomati ayarlayacak kod bulamadım henüz

Sub FormatliAra(ByVal txtAranan As String)

Dim RngAra As Range

Dim RngSonuc As Range

Dim RngBul As Range

Dim RngBul2 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 RngBul2 = RngAra.Find("IVL No", SearchFormat:=True)

        

    If RngBul2 Is Nothing Then rngRow = Sht2.Cells(Sht2.Rows.Count, "A").End(xlUp).Row Else rngRow = RngBul2.Row - 1

    

    Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":L" & rngRow)

    Sht.Range("C2:XFD" & Rows.Count).Clear

    RngSonuc.Copy

    Sht.Range("C2").PasteSpecial xlPasteAllUsingSourceTheme



    .Range("C2:N" & SonStr).BorderAround Weight:=xlThin

End With

    Application.FindFormat.Clear

End Sub

dosyanın son hali bu, dilerim işinize yarar

Sub FormatliAra(ByVal txtAranan As String)

Dim RngAra As Range

Dim RngSonuc As Range

Dim RngBul As Range

Dim RngBul2 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 'formatlı arama için gerekli kod

With Sht

    Set RngBul = RngAra.Find(txtAranan, SearchFormat:=True)

    SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row

    

    For iCntr = 3 To 17

    .Columns(3).EntireColumn.Delete

    Next

        .Cells.RowHeight = 15



    If RngBul Is Nothing Then Exit Sub 'veri yoksa işlemi iptal etme

    Sh2SonStr = Sht2.Cells(Sht2.Rows.Count, "A").End(xlUp).Row

    Set RngAra = Sht2.Range("A" & RngBul.Row & ":A" & Sh2SonStr)

    Set RngBul2 = RngAra.Find("IVL No", SearchFormat:=True)

        

    If RngBul2 Is Nothing Then rngRow = Sh2SonStr Else rngRow = RngBul2.Row - 1

    

    Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":O" & rngRow)

    RngSonuc.Copy

    .Range("C2").PasteSpecial xlPasteAll

    .Cells.EntireColumn.AutoFit

    SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row

    .Range("A" & SonStr).RowHeight = Sht2.Range("A148").RowHeight

End With

    Application.FindFormat.Clear

    Application.CutCopyMode = False

    

End Sub