Çözüldü Veri doğrulama ile veya hücre değerine göre sekmeleri Göster/Gizle

[ptcsite]

Aşağıdaki kodu nasıl sağdeleştirebilirim... Konusu: birden fazla gizli sekme var.. bu sekmeleri veri doğrulama listesinden seçimime göre açılmasını diğerlerinin de gizlenmesini istiyorum. Sadece "LİSTE" sekmesi her zaman açık olacak...

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "12345"
Application.ScreenUpdating = True
If Intersect(Target, [F2]) Is Nothing Then Exit Sub
If [F2] <> "" Then
Sheets("LİSTE").Visible = True
Sheets("Str").Visible = True
Sheets("A01").Visible = xlSheetVeryHidden
Sheets("A02").Visible = xlSheetVeryHidden
Sheets("A03").Visible = xlSheetVeryHidden
Sheets("A04").Visible = xlSheetVeryHidden
Sheets("A05").Visible = xlSheetVeryHidden
Sheets("A06").Visible = xlSheetVeryHidden
Sheets("A07").Visible = xlSheetVeryHidden
Sheets("A08").Visible = xlSheetVeryHidden
Sheets("A09").Visible = xlSheetVeryHidden
Sheets("A10").Visible = xlSheetVeryHidden
Sheets("A11").Visible = xlSheetVeryHidden
Sheets("A12").Visible = xlSheetVeryHidden
Sheets("A13").Visible = xlSheetVeryHidden
Sheets("A14").Visible = xlSheetVeryHidden
Sheets("A15").Visible = xlSheetVeryHidden
Sheets("A16").Visible = xlSheetVeryHidden
Sheets("A17").Visible = xlSheetVeryHidden
Sheets("A18").Visible = xlSheetVeryHidden
Sheets("A19").Visible = xlSheetVeryHidden
Sheets("A20").Visible = xlSheetVeryHidden
Sheets("A21").Visible = xlSheetVeryHidden
Sheets("A22").Visible = xlSheetVeryHidden
Sheets("A23").Visible = xlSheetVeryHidden
Sheets("A24").Visible = xlSheetVeryHidden
Sheets("A25").Visible = xlSheetVeryHidden
Sheets("A26").Visible = xlSheetVeryHidden
Else
Sheets("LİSTE").Visible = True
Sheets("Str").Visible = xlSheetVeryHidden
Sheets("A01").Visible = xlSheetVeryHidden
Sheets("A02").Visible = xlSheetVeryHidden
Sheets("A03").Visible = xlSheetVeryHidden
Sheets("A04").Visible = xlSheetVeryHidden
Sheets("A05").Visible = xlSheetVeryHidden
Sheets("A06").Visible = xlSheetVeryHidden
Sheets("A07").Visible = xlSheetVeryHidden
Sheets("A08").Visible = xlSheetVeryHidden
Sheets("A09").Visible = xlSheetVeryHidden
Sheets("A10").Visible = xlSheetVeryHidden
Sheets("A11").Visible = xlSheetVeryHidden
Sheets("A12").Visible = xlSheetVeryHidden
Sheets("A13").Visible = xlSheetVeryHidden
Sheets("A14").Visible = xlSheetVeryHidden
Sheets("A15").Visible = xlSheetVeryHidden
Sheets("A16").Visible = xlSheetVeryHidden
Sheets("A17").Visible = xlSheetVeryHidden
Sheets("A18").Visible = xlSheetVeryHidden
Sheets("A19").Visible = xlSheetVeryHidden
Sheets("A20").Visible = xlSheetVeryHidden
Sheets("A21").Visible = xlSheetVeryHidden
Sheets("A22").Visible = xlSheetVeryHidden
Sheets("A23").Visible = xlSheetVeryHidden
Sheets("A24").Visible = xlSheetVeryHidden
Sheets("A25").Visible = xlSheetVeryHidden
Sheets("A26").Visible = xlSheetVeryHidden
End If
ActiveSheet.Protect "12345"
Application.ScreenUpdating = False
End Sub

Yukarıdakinde sadece STR sekmesi açılsın, listede boş seçince STR gizlensin diye yaptım.. Ama bunu çoğaltırsam amelelik olacak... Bunun daha kısa yolu nasıl olur?

 

[ptcsite]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="12345"
   Dim Syf As Worksheet
    Dim Hucre As Range
    Set Hucre = Range("L1")
If Target.Address = Hucre.Address Then
    For Each Syf In Worksheets
        Select Case Syf.Name
        Case "Menu", Hucre.Value
            Syf.Visible = xlSheetVisible
        Case Else
            Syf.Visible = xlSheetVeryHidden
            Sheets("REHBER").Visible = xlSheetVisible
        End Select
    Next Syf
End If
ActiveSheet.Unprotect Password:="12345"
End Sub

Böyle bir Cod buldum Veri doğrulamada listesinden seçtiğimde ilgili sekmeyi aynen gösterip gizliyor. Lakin sekmedeki adı kısaltma olunca bende başka bir veri doğrulama ile Düşey arama yöntemiyle kısaltmaları adresledim başka bir hücrede... Yani Listeden seçtiğim isime karşı hücrede çıkan kısaltmaya yukardaki makroyu bağladığımda çalışmıyor sistem...

 

[ptcsite]

Yani F2 deki veri ismini düşey ara ile L1 de kısaltmasına aktarıp yukarıdaki kodu L1 den alsın dedim. Ama F2 den isim seçiyorum L1 de kısaltması çıkıoyr ama çıkan kısaltmaya binaen ilgili sekme görünmüyor

 

[ptcsite]

Private Sub worksheet_change(ByVal target As Excel.Range)
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        If ws.Name <> "LİSTE" And ws.Name <> Worksheets("LİSTE").Range("L1").Value Then
            ws.Visible = False
        End If
        If ws.Name = Worksheets("LİSTE").Range("L1").Value Then
            ws.Visible = True
        End If
    Next ws
        
End Sub

Yoğun araştırmalar sonucu internette buldum ve oldu Bu da Listeden seçilen verinin düşey ara ile kısaltmasına bağlanmış hücredeki değere göre sekmeyi gizleyip gösteriyor. Not: LİSTE sekmesi her zaman göster konumunda... L1 hücresindeki isme ait sekme görünür oluyor. diğer sekmeler gizleniyor...