muratgunay48
Altın Üye
- Katılım
- 10 Şubat 2010
- Mesajlar
- 1,311
- Excel Vers. ve Dili
- Office 365 - Türkçe (64 bit)
- Altın Üyelik Bitiş Tarihi
- 31-01-2026
@Korhan Ayhan hocamızın yazmış olduğu bu kodda, "sayfalar bulundu" deyince. Listelediği sayfaya direk gidiyordu. Şimdi sayfaları buluyor ama, manuel "ANA SAYFA" ya gitmem gerekiyor. Bir satır falan mı silmişim acaba yanlışlıkla.
Option Explicit
Sub Sayfa_Adi_Bul()
Dim S1 As Worksheet, Sayfa As Worksheet, Aranan_Sayfa_Adi As Variant, Say As Integer, Veri As Range
Aranan_Sayfa_Adi = InputBox("Aradığınız sayfa adını giriniz...", "Aranan Sayfa Adı")
If Aranan_Sayfa_Adi = "" Or Aranan_Sayfa_Adi = False Then
MsgBox "İşleme devam edebilmeniz için lütfen aradığınız sayfa adını giriniz!", vbCritical
Exit Sub
End If
Set S1 = Sheets("ANA SAYFA")
S1.Range("A2:A" & S1.Rows.Count).ClearContents
ReDim Liste(1 To ThisWorkbook.Worksheets.Count, 1 To 1)
For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> S1.Name Then
If UCase(Replace(Replace(Left(Sayfa.Name, Len(Aranan_Sayfa_Adi)), "ı", "I"), "i", "İ")) = _
UCase(Replace(Replace(Aranan_Sayfa_Adi, "ı", "I"), "i", "İ")) Then
Say = Say + 1
Liste(Say, 1) = Sayfa.Name
End If
End If
Next
If Say > 0 Then
With S1
.Range("A1") = "Sayfalar"
.Range("A1").Font.Bold = True
.Range("A2").Resize(Say, 1) = Liste
.Range("A2:A" & .Rows.Count).Sort Key1:=.Range("A2"), Order1:=xlAscending
For Each Veri In .Range("A2").Resize(Say, 1)
Veri.Hyperlinks.Add Anchor:=Veri, Address:="", SubAddress:="'" & Veri.Value & "'!A1", TextToDisplay:=Veri.Value
Next
End With
MsgBox "Bulunan sayfalar listelenmiştir.", vbInformation
Else
MsgBox "Aradığınız sayfa bulunamadı!", vbCritical
End If
End Sub
Option Explicit
Sub Sayfa_Adi_Bul()
Dim S1 As Worksheet, Sayfa As Worksheet, Aranan_Sayfa_Adi As Variant, Say As Integer, Veri As Range
Aranan_Sayfa_Adi = InputBox("Aradığınız sayfa adını giriniz...", "Aranan Sayfa Adı")
If Aranan_Sayfa_Adi = "" Or Aranan_Sayfa_Adi = False Then
MsgBox "İşleme devam edebilmeniz için lütfen aradığınız sayfa adını giriniz!", vbCritical
Exit Sub
End If
Set S1 = Sheets("ANA SAYFA")
S1.Range("A2:A" & S1.Rows.Count).ClearContents
ReDim Liste(1 To ThisWorkbook.Worksheets.Count, 1 To 1)
For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> S1.Name Then
If UCase(Replace(Replace(Left(Sayfa.Name, Len(Aranan_Sayfa_Adi)), "ı", "I"), "i", "İ")) = _
UCase(Replace(Replace(Aranan_Sayfa_Adi, "ı", "I"), "i", "İ")) Then
Say = Say + 1
Liste(Say, 1) = Sayfa.Name
End If
End If
Next
If Say > 0 Then
With S1
.Range("A1") = "Sayfalar"
.Range("A1").Font.Bold = True
.Range("A2").Resize(Say, 1) = Liste
.Range("A2:A" & .Rows.Count).Sort Key1:=.Range("A2"), Order1:=xlAscending
For Each Veri In .Range("A2").Resize(Say, 1)
Veri.Hyperlinks.Add Anchor:=Veri, Address:="", SubAddress:="'" & Veri.Value & "'!A1", TextToDisplay:=Veri.Value
Next
End With
MsgBox "Bulunan sayfalar listelenmiştir.", vbInformation
Else
MsgBox "Aradığınız sayfa bulunamadı!", vbCritical
End If
End Sub