rehberde sayfadan aratma

[nickelaj]

Merhaba
Sayfaları alfebatik düzenlenmiş rehberim vardı. ona programla arama yaptırmaya çalışıyorum fakat birtürlü yapamıyorum. yardımcı olabilirseniz sevinirim.

(dosya eklemede sürekli hata verdiğinden kodu yazıyorum)

Private Sub CommandButton1_Click()

On Error Resume Next
TextBox2.MultiLine = True
If (TextBox1.Value) = "" Then MsgBox "Lütfen Firma Adını Boş Bırakmayın"

For i = 1 To Worksheets.Count

Sheets(i).Select
If (TextBox1.Value) = [b3:b7465].Find(TextBox1.Value).Select Then
TextBox2 = Selection.Offset(0, 1)
TextBox3 = Selection.Offset(0, 2)
TextBox4 = Selection.Offset(0, 3)
TextBox5 = Selection.Offset(0, 4)
TextBox6 = Selection.Offset(0, 5)
TextBox7 = Selection.Offset(0, 0)

End If
Next i

End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Private Sub CommandButton1_Click()
    Dim i As Integer, Bul As Range, Say As Byte
    
    TextBox2.MultiLine = True
    
    If TextBox1.Value = "" Then
    MsgBox "Lütfen Firma Adını Boş Bırakmayın"
    Exit Sub
    End If
    
    For i = 1 To Worksheets.Count
        With Sheets(i)
            Set Bul = .Range("B3:B65536").Find(TextBox1.Value)
            If Not Bul Is Nothing Then
            Say = Say + 1
            TextBox7 = .Cells(Bul.Row, 2)
            TextBox2 = .Cells(Bul.Row, 3)
            TextBox3 = .Cells(Bul.Row, 4)
            TextBox4 = .Cells(Bul.Row, 5)
            TextBox5 = .Cells(Bul.Row, 6)
            TextBox6 = .Cells(Bul.Row, 7)
            Exit Sub
            End If
        End With
    Next i
    
    Set Bul = Nothing
    
    If Say = 0 Then MsgBox "Aradığınız kayıt bulunamamıştır!", vbCritical, "Dikkat !"
End Sub

 

[nickelaj]

korhan bey ellerinize sağlık.
tam istediğim gibi olmuş. çok teşekkürler