idealimsin
Altın Üye
- Katılım
- 2 Ekim 2011
- Mesajlar
- 356
- Excel Vers. ve Dili
- excel 360 TR 64bit
- Altın Üyelik Bitiş Tarihi
- 15-04-2025
Kod:
Option Explicit
Sub Bul_Listele()
Dim S1 As Worksheet, S2 As Worksheet, Bul As Range, Say As Long
Dim Adres As String, Aranan As Variant, Satir As Long
Aranan = Application.InputBox("Aradığınız veriyi giriniz.", "Aranan Veri")
If Aranan = "" Or Aranan = False Then Exit Sub
Set S1 = Sheets("Sayfa1")
Satir = 1
Set Bul = S1.Cells.Find(Aranan, , , xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
On Error Resume Next
Set S2 = Nothing
Set S2 = Sheets(Aranan)
On Error GoTo 0
If S2 Is Nothing Then
Set S2 = Sheets.Add(, Sheets(Sheets.Count))
S2.Name = Aranan
Else
S2.Cells.Clear
End If
Do
Bul.Interior.ColorIndex = 4
Bul.Offset(-2).Resize(30, 16).Copy S2.Cells(Satir, Bul.Column)
Say = Say + 1
Satir = Satir + 35
Set Bul = S1.Cells.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
If Say > 0 Then
MsgBox "Bulunan veriler aktarılmıştır.", vbInformation
Else
MsgBox "Aranan veri bulunamadı!" & Chr(10) & Chr(10) & _
"Aranan veri ; " & Aranan, vbCritical
End If
End Sub