Bir hücreye bağlı sayfa isimlerinin değişmesi

[Bkts61]

Merhaba ,
Bir Excel dosyasında A sayfasi icerisinde I1 den AJ1 e kadar her bir hücrenin içerisindeki tarihlerin ,yine aynı Excel çalışma kitabındaki Sayfa1 den Sayfa 28 e kadar olan her bir sayfa A sayfası içerisindeki yukarıdaki belirttiğim hücrelerin değerlerini alsın .
Mesela
Sayfa1 in ismi A sayfasındaki I1 hucresindeki tarih olmalı (örneğin 15.02.2023 )
Sayfa2 nin ismi A sayfasındaki J1 hucresindeki tarih olmalı ve bu sıralı bir şekilde devam etmeli .

Geri donusunuzu acil bekliyorum . Saygılar

 

[dEdE]

Aşağıdaki kodu bir modüle yapıştırarak dener misiniz?

Sub Sayfa_Ac()
    For i = 9 To 36
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Sheets("A").Cells(1, i).Value
    Next i
End Sub

 

[nongeyikm]

Sn. dede

Sayfa isimlerini, her sayfanın A1 hücresinden almasını istesem bu kod nasıl olur.

 

[Korhan Ayhan]

@nongeyikm,

Deneyiniz.

Option Explicit

Sub Update_Sheets_Name()
    Dim Sh As Worksheet
   
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Range("A1").Text <> "" Then
            On Error Resume Next
            Sh.Name = Sh.Range("A1").Text
            If Err.Number = 1004 Then MsgBox "Geçersiz karakter tespit edildi!", vbCritical
            Err.Clear
            On Error GoTo 0
        End If
    Next
   
    MsgBox "Sayfa isimleri güncellenmiştir."
End Sub

 

[Korhan Ayhan]

@nongeyikm,

Alternatif olarak aşağıdaki kodu ThisworkBook bölümüne uygularsanız sayfalarda A1 hücresini değiştirdikçe sayfa isimleri değişecektir.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Sh.Range("A1").Text <> "" Then
        On Error Resume Next
        Sh.Name = Left(Sh.Range("A1").Text, 31)
        If Err.Number = 1004 Then MsgBox "Geçersiz karakter tespit edildi!", vbCritical
        Err.Clear
        On Error GoTo 0
    End If
End Sub

 

[Bkts61]

Malesef hiç biri olmadı .
Tekrar anlatım .
Daily Plan adlı sayfanın I1 hucresindeki değer
Sayfa1 İn ismi olsun .

Yani Daily Plan sayfasinda I1 hucresindeki değer 10.02.2023 ise sayfa1 ismi 10.02.2023 olacak ve daha sonrasında Daily plan sayfasindaki tarih her değişmesinde sayfa1 in ismide değişsin . Bu kod lazım ...

 

[Korhan Ayhan]

Benim cevaplarım diğer üyemizin sorusu içindi.

Sizin sorunuzda önemli olan ismi değişecek sayfaların dizilimidir. Dizilimde aralarda ismi değişmeyecek sayfa var mı? Bunlar önem arz ediyor.

 

[Bkts61]

Benim cevaplarım diğer üyemizin sorusu içindi.

Sizin sorunuzda önemli olan ismi değişecek sayfaların dizilimidir. Dizilimde aralarda ismi değişmeyecek sayfa var mı? Bunlar önem arz ediyor.

Değişmeyecek sayfa yok . Sayfa1 den Sayfa 28 e kadar değişecek .

 

[Korhan Ayhan]

Yani sayfa dizilimi aşağıdaki gibi mi?

Daily Plan / Sayfa1 / Sayfa2 .......

 

[Bkts61]

Yani sayfa dizilimi aşağıdaki gibi mi?

Daily Plan / Sayfa1 / Sayfa2 .......

Daily Plan/Weekly Plan/Daily Review/Weekly Review/Sayfa1/Sayfa2/.....Sayfa28 de bitiyor

 

[Korhan Ayhan]

İsmi değişecek sayfaların sıra numarası verdiğiniz dizilime göre 5 ten başlıyor.

Bu sebeple kod içinde No = 5 olarak kullandım.

Deneyiniz.

Option Explicit

Sub Update_Sheets_Name()
    Dim S1 As Worksheet, Sh As Worksheet
    Dim Rng As Range, No As Integer
    
    Set S1 = Sheets("Daily Plan")
    
    No = 5
    
    For Each Rng In S1.Range("I1:AJ1")
        If Rng <> "" Then
            On Error Resume Next
            Set Sh = Nothing
            Set Sh = Sheets(No)
            On Error GoTo 0
            If Not Sh Is Nothing Then Sh.Name = Left(Rng.Value, 31)
        End If
        No = No + 1
    Next
    
    Set S1 = Nothing
    
    MsgBox "Sayfa isimleri güncellenmiştir.", vbInformation
End Sub

 

[Bkts61]

İsmi değişecek sayfaların sıra numarası verdiğiniz dizilime göre 5 ten başlıyor.

Bu sebeple kod içinde No = 5 olarak kullandım.

Deneyiniz.

Option Explicit

Sub Update_Sheets_Name()
    Dim S1 As Worksheet, Sh As Worksheet
    Dim Rng As Range, No As Integer
   
    Set S1 = Sheets("Daily Plan")
   
    No = 5
   
    For Each Rng In S1.Range("I1:AJ1")
        If Rng <> "" Then
            On Error Resume Next
            Set Sh = Nothing
            Set Sh = Sheets(No)
            On Error GoTo 0
            If Not Sh Is Nothing Then Sh.Name = Left(Rng.Value, 31)
        End If
        No = No + 1
    Next
   
    Set S1 = Nothing
   
    MsgBox "Sayfa isimleri güncellenmiştir.", vbInformation
End Sub

Öncelikle çok teşekkürler . Fakat olmadı .
Deneme için I1 e tarih yazdım fakat herhangi bir değişiklik yok

 

[Korhan Ayhan]

Kodu bir butona atayıp kullanabilirsiniz.

 

[Bkts61]

Kodu bir butona atayıp kullanabilirsiniz.

Aradım tikladigimda Next without for hatası alıyorum .ve kod içinde next yazan yeri işaret ediyor

 

[Korhan Ayhan]

Uygulama yaptığınız örnek dosyayı paylaşırsanız deneme şansım olabilir.

 

[Bkts61]

Uygulama yaptığınız örnek dosyayı paylaşırsanız deneme şansım olabilir.

Uygulama yaptığınız örnek dosyayı paylaşırsanız deneme şansım olabilir.

Altın üyelik yapılması gerekli herhalde gönderim için

 

[Korhan Ayhan]

Harici dosya barındırma sitelerine dosyanızı yükleyip linkini forumda paylaşabilirsiniz.

 

[Bkts61]

Harici dosya barındırma sitelerine dosyanızı yükleyip linkini forumda paylaşabilirsiniz.

TMK_Follow_Up.xlsx dosyasını indir - download

TMK_Follow_Up.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

 

[nongeyikm]

Hayırlı sabahlar.

Çok teşekkürler Korhan Bey

 

[Bkts61]

TMK_Follow_Up.xlsx dosyasını indir - download

TMK_Follow_Up.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

Korhan bey bakanbildinizmi acaba?