Bul ve tüm bilgileri aktar

[DeliBalta58]

Veri sayfamda ( 65500 veri olacağı düşünülecek)
O1 Hücresine girilen değeri
B Sütunuda arama yapacak
uyan verilerin tamamını Form sayfasına aktaracak

yardımcı olabilirmisiniz.
dosyam ekte

 

[Orion1]

Ekli dosyayı incelyiniz.

Sub bul_aktar()
Dim k As Range, a As Long, j As Byte, ilkadres As String
Sheets("Veri").Select
Sheets("Form").Range("A2:N65536").Clear
If Range("O1") = "" Then Exit Sub
ReDim myarr(1 To 14, 1 To 1)
Set k = Range("B:B").Find(Range("O1").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    ilkadres = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 14, 1 To a)
        myarr(1, a) = a
        For j = 2 To 14
            myarr(j, a) = Cells(k.Row, j).Value
        Next j
        Set k = Range("B:B").FindNext(k)
    Loop While ilkadres <> k.Address And Not k Is Nothing
End If
Application.ScreenUpdating = False
Sheets("Form").Select
If a > 0 Then
    [A2].Resize(a, 14) = Application.Transpose(myarr)
End If
Application.ScreenUpdating = True
MsgBox "İşlem Tamam..!!", vbOKOnly + vbInformation, "BUL"
End Sub

 

[DeliBalta58]

eklenen dosya indirilemiyor.

Ayrıca aranan değer sütunda yoksa hata veriyor

 

[Orion1]

eklenen dosya indirilemiyor.

Ayrıca aranan değer sütunda yoksa hata veriyor

Düzeltildi .Tekrardan indirip deneyiniz.

 

[DeliBalta58]

Teşekkürler

 

[Orion1]

Teşekkürler

Rica ederim.