Hücredeki yazıya ait sayfaya gitmek

[Alperen25]

Merhaba arkadaşlar,

Etiket çalışması için hazırladığım bir dosyam var. Ama istediğim gibi bir netice alamadım. Yardımlarınızı rica ediyorum.
İstediğim şey şu; belirlediğim bir hücrem var. Her sayfanın B1 hücresini belirledim. Buraya, veri doğrulama bölümünden listeyi seçip mevcut sayfalarımın listesini ekledim. Bu listeden seçim yapıp o sayfa gitmek istiyorum. Ama yapamadım.
Aşağıdaki kod ile mevcut tüm sayfaların listesini A sütununa yazdırıyorum. B1 sütununda ise veri doğrulama ile bu listeden seçim yapabiliyorum. Ama seçtiğim sayfaya gidemedim.

Sub sayfalar()
Columns(1).ClearContents
a = 1
Cells(a, 1) = "MODEL İSİMLERİ"
Cells(a, 1).Font.Bold = True
For Each c In Sheets
    a = a + 1
    Cells(a, 1) = c.Name
Next
End Sub

Çalışma dosyası; Etiket hazırlık.xlsm - 7.6 MB

 

[turist]

SHS1 sayfa kodu kısmına aşağıdaki kodları yazın, SHS1 sayfasındaki "Listeyi Yenile" butonuna tıklayın.
B1 hücresinden sayfa ismi seçerek deneyin.

Sub sayfalar()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Columns(1).Clear
a = 1
Cells(a, 1) = "MODEL İSİMLERİ"
Cells(a, 1).Font.Bold = True
For Each c In Sheets
    a = a + 1
    Cells(a, 1) = c.Name
Next
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).CreateNames Top:=True, Left:=False, Bottom:=False, Right:=False
    With [B1].Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=MODEL_İSİMLERİ"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
  [B1].Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target <> [B1] Then Exit Sub
sayfa = Target.Value
Sheets(sayfa).Select
Application.ScreenUpdating = True
End Sub

 

[Alperen25]

İlginiz için çok teşekkür ederim.
İşleyiş biraz değişti ve biraz farklılıklar var.
Bu yüzden yeni konu olarak açtım.

Yeni konu linki :

https://www.excel.web.tr/threads/li...cekme-ve-miktar-kadar-cogaltma-islemi.176325/