Sayfa adlarını hücrelerden almak

ASLAN7410 · 16 Ocak 2016

Merhaba herkese hayırlı akşamlar.

Ekte gönderdiğim excel sayfasının ANA SAYFA isimli sayfasının I8 ile I17 hücrelerine yazdığım yıllara göre, alt sayfa isimlerinin bu hücrelere göre değişmesini istiyorum.

Forumda ve net'te araştırdım ancak benim istediğim gibi bir şey bulamadım.

Yardım edecek arkadaşlara şimdiden teşekkür ederim.

YUSUF44 · 16 Ocak 2016

Aşağıdaki kodlar I ve H sütununda değişikliklik olduğunda istediğinizi yapıyor ama kodlara sayfa sayısıyla yıl sayısının kontrolünün eklenmesi gerekiyor:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
son = WorksheetFunction.Max(Cells(Rows.Count, "H").End(3).Row, 8)
If Intersect(Target, Range("H8:I" & son)) Is Nothing Then Exit Sub
ActiveSheet.Move Before:=Sheets(1)
    For eskisayfa = 2 To Sheets.Count
            Sheets(eskisayfa).Name = "kontrol " & eskisayfa
    Next

yıl = 8
    For sayfa = 2 To Sheets.Count
        Sheets(sayfa).Name = Cells(yıl, "I")
        yıl = yıl + 1
    Next

End Sub

ASLAN7410 · 16 Ocak 2016

Sayın Yusuf Bey ilginiz için çok teşekkür ediyorum, ellerinize sağlık tam istediğim gibi olmuş, çok teşekkürler.

Küçük bir sorum daha var, I8 ile I17 hücrelerine bastığım zaman ilgili sayfanın B5 hücresine gitsin.

YUSUF44 · 16 Ocak 2016

Sayfa sayısı kontrolünü eklediğim hali şu şekildedir:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
son = WorksheetFunction.Max(Cells(Rows.Count, "H").End(3).Row, 8)
If Intersect(Target, Range("H8:I" & son)) Is Nothing Then Exit Sub
sayfasayısı = Sheets.Count
yılsayısı = son - 7
If [I8] = "" Then Exit Sub
If sayfasayısı - 1 < yılsayısı Then
    uyarı = MsgBox("Mevcut sayfa sayısı yıl sayısından azdır!" & Chr(10) & _
    "Gerekli sayfalar eklensin mi?", vbYesNo)
    If uyarı = vbYes Then
        ek = yılsayısı - sayfasayısı + 1
        For ekle = 1 To ek
            Sheets.Add
        Next
    Else
    GoTo 10
    End If
End If
10:
        Sheets("ANA SAYFA").Move Before:=Sheets(1)
        
        For eskisayfa = 2 To Sheets.Count
            Sheets(eskisayfa).Name = "kontrol " & eskisayfa
        Next

        yıl = 8
        For sayfa = 2 To WorksheetFunction.Min(yılsayısı + 1, Sheets.Count)
            Sheets(sayfa).Name = Cells(yıl, "I")
            yıl = yıl + 1
        Next

End Sub

"bastığım zaman gitsin" isteğinizi anlamadım maalesef. O hücreler seçildiğinde ilgili sayfaya gitmesini istiyorsunuz ama verdiğim kodlar o hücrelerin değişmesi şartına bağlı. Sizin istediğiniz olursa çakışma olur, sayfa adlandırma mı yapsın ilgili sayfaya mı gitsin bilemez diye düşünüyorum. Belki o hücrelere çift tıklama yapıldığında çalışacak bir kod olabilir ama seçildiğinde gitmesi önceki kodların çalışma mantığına aykırı.

ASLAN7410 · 16 Ocak 2016

İlginiz için çok teşekkür ederim, ellerinize sağlık tam istediğim gibi oldu.

Hayırlı geceler hayırlı çalışmalar.

ASLAN7410 · 16 Ocak 2016

Sayın Yusuf Bey aşağıdaki kodu forumda buldum hücreye tıkladığımda ilgili sayfaya gidiyor ancak istediğim hücrede durmasını istiyorum.
Yardımcı olur musun?

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
Dim Sayfa As String
If Intersect(Target, [I8:I17]) Is Nothing Then Exit Sub
Sayfa = Target.Value
Sheets(Sayfa).Select
Exit Sub
Son:
End Sub

YUSUF44 · 16 Ocak 2016

Çift tıklamayla değil ama aşağıdaki kodları da sayfanın kod bölümüne eklerseniz J sütununda hücre seçtiğinizde I sütunundaki sayfaya gidebilirsiniz:

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
son = WorksheetFunction.Max(Cells(Rows.Count, "I").End(3).Row, 8)
If Intersect(Target, Range("J8:J" & son)) Is Nothing Then Exit Sub
a = Target.Row
For yıllar = 1 To Sheets.Count
    If WorksheetFunction.Proper(Sheets(yıllar).Name) = WorksheetFunction.Proper(Cells(a, "I")) Then
        Sheets(yıllar).Activate
        Sheets(yıllar).[b5].Select
        yıllar = Sheets.Count
    End If
Next
End Sub

Ömer BARAN · 16 Ocak 2016

Yanlış mesajı sildim.

vardar07 · 16 Ocak 2016

Exit Sub satırından önce ekleyip denermisiniz. Kırmızılı 1 satır mor 1 sütun

Kod:

Sheets(Sayfa).Cells([COLOR="Red"][B]1[/B][/COLOR],[COLOR="Blue"][B]1[/B][/COLOR]).Select

YUSUF44 · 16 Ocak 2016

Sayın vardar'ın belirttiği gibi (1,1 yerine 5,2 kullanarak) ya da aşağıdaki gibi yaparsanız kod çalışıyor ama dediğim gibi o hücreleri değiştirmek istediğinizde verimli olmuyor:

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
Dim Sayfa As String
If Intersect(Target, [I8:I17]) Is Nothing Then Exit Sub
Sayfa = Target.Value
Sheets(Sayfa).Select
Sheets(Sayfa).[B5].Select
Exit Sub
Son:
End Sub

ASLAN7410 · 16 Ocak 2016

Cevap veren herkese çok teşekkür ediyorum.

Sayın Yusuf Bey sizin yazmış olduğunuz aşağıdaki kodlar çok işime yaradı, çok teşekkür ediyorum.
Hayırlı geceler, hayırlı çalışmalar.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Son = WorksheetFunction.Max(Cells(Rows.Count, "H").End(3).Row, 8)
If Intersect(Target, Range("H8:I" & Son)) Is Nothing Then Exit Sub
ActiveSheet.Move Before:=Sheets(1)
    For eskisayfa = 2 To Sheets.Count
            Sheets(eskisayfa).Name = "kontrol " & eskisayfa
    Next
yıl = 8
    For Sayfa = 2 To Sheets.Count
        Sheets(Sayfa).Name = Cells(yıl, "I")
        yıl = yıl + 1
    Next
End Sub

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
Dim Sayfa As String
If Intersect(Target, [j8:j17]) Is Nothing Then Exit Sub
Sayfa = Target.Value
Sheets(Sayfa).Select
Sheets(Sayfa).[B5].Select
Exit Sub
Son:
End Sub

ASLAN7410 · 18 Ocak 2016

Sayın Yusuf Bey sizin katkılarınızla ekte gönderdiğim apartman yönetici sayfası hazırlamaya çalıştım.

Yeni sayfayı elle eklemek istediğim zaman kontrol22 diye bir sayfa oluşturuyor ve debug veriyor.
ANA SAYFA isimli sayfanın D8 hücresine yılı yazdığım zaman diğer yıllar otomatik olarak artıyor.

Sizin yazmış olduğunuz kodlar sayfanın ANA SAYFA isimli sayfanın kod bölümündedir.

Sayfaların koruması şifresizdir.

YUSUF44 · 19 Ocak 2016

Günaydın. Öncelikle dosya yapınızın değişmiş olduğunu görüyorum. Önceden sadece yıl sayfaları varken şimdi bir de yıl H dosyaları var.

Dosyaya sayfa sekmelerinin yanındaki + tuşuna basarak yeni sayfa ekledim ama belirttiğiniz gibi kontrol22 diye bir sayfa eklemedi.

Ana sayfa'da ilk yılı değiştirdiğimde diğer yılların otomatik artması bana ait değil, sayfa korumasını kaldırdığınızda göreceksiniz ki alt hücrelere =D8+1 şeklinde formül girmişsiniz. D8 değişince diğer hücreler de bu formüle bağlı olarak birer artıyor.

Kontrol22 olayı ise şunun içindi: Soruyu ilk sorduğunuzda yaptığım denemeler sonucu önce Ana sayfayı en başa taşımam gerektiği, sonra 2. sayfadan itibaren tüm sayfaların kontrol1, kontrol2 gibi ad alması gerektiğini anladım. Çünkü eğer mevcut sayfaların ismini bu şekilde değiştirmezsem örneğin dosyada zaten 2017 isimli sayfa varsa makro "daha önce bu isimli sayfa var" diyerek çalışmayı durduruyordu. Ben böyle yaparak tüm sayfaların ismini benzersiz olarak değiştirip sonra isimlendirmeyi yeniden yapıyordum.

VErdiğim son kodlarda sayfa sayısı kontrol ediliyordu, onları kullanmamışsınız.

Tüm bu bilgiler ışığında dosya aslından çok farklı bir hal aldığından çözüm bulmak için kodları baştan değerlendirmemiz gerekiyor. Bunun için de sanki önceki konular hiç konuşulmamış gibi dosyada düzeltilmesi gereken yerleri belirtirseniz elimden geldiğince yardımcı olmaya çalışırım.

ASLAN7410 · 20 Ocak 2016

Sayın Yusuf Bey ilginiz için çok teşekkür ediyorum.
Vardiyalı çalıştığım için bilgisayar başına yeni geçebildim.

Ana sayfanın görselliği için sütunlarda değişiklik yapmıştım.
Sizin vermiş olduğunuz son kodları yeni oluşturduğum sayfama uyarlıyamadım.

Çözüm için Ana Sayfa isimli sayfanın kod kısmına aşağıdaki gibi kodu hazırladım, bu seferde kodlar uzun oldu.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
Worksheets(2).Name = "a"
Worksheets(3).Name = "b"
Worksheets(4).Name = "c"
Worksheets(5).Name = "d"
Worksheets(6).Name = "e"
Worksheets(7).Name = "f"
Worksheets(8).Name = "g"
Worksheets(9).Name = "h"
Worksheets(10).Name = "ı"
Worksheets(11).Name = "j"
Worksheets(12).Name = "k"
Worksheets(13).Name = "l"
Worksheets(14).Name = "m"
Worksheets(15).Name = "n"
Worksheets(16).Name = "o"
Worksheets(17).Name = "p"
Worksheets(18).Name = "r"
Worksheets(19).Name = "s"
Worksheets(20).Name = "t"
Worksheets(21).Name = "u"

Worksheets(2).Name = Range("D8")
Worksheets(3).Name = Range("D9")
Worksheets(4).Name = Range("D10")
Worksheets(5).Name = Range("D11")
Worksheets(6).Name = Range("D12")
Worksheets(7).Name = Range("D13")
Worksheets(8).Name = Range("D14")
Worksheets(9).Name = Range("D15")
Worksheets(10).Name = Range("D16")
Worksheets(11).Name = Range("D17")
Worksheets(12).Name = Range("D18")
Worksheets(13).Name = Range("D19")
Worksheets(14).Name = Range("D20")
Worksheets(15).Name = Range("D21")
Worksheets(16).Name = Range("D22")
Worksheets(17).Name = Range("D23")
Worksheets(18).Name = Range("D24")
Worksheets(19).Name = Range("D25")
Worksheets(20).Name = Range("D26")
Worksheets(21).Name = Range("D27")
Application.ScreenUpdating = True
End Sub

Yukarıdaki kod basitçe nasıl kısaltılır.

vardar07 · 20 Ocak 2016

Buyurun.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, 8)
If Intersect(Target, Range("C8:D" & Son)) Is Nothing Then Exit Sub
ActiveSheet.Move Before:=Sheets(1)
 Application.ScreenUpdating = False
   For eskisayfa = 1 To Sheets.Count
    [COLOR="Red"]If Sheets(eskisayfa).Name <> "ANA SAYFA" And Sheets(eskisayfa).Name <> "MAKBUZ" Then[/COLOR]
            Sheets(eskisayfa).Name = "a" & eskisayfa
            End If
    Next
    a = 8
    For eskisayfa = 1 To Sheets.Count
    [COLOR="red"]If Sheets(eskisayfa).Name <> "ANA SAYFA" And Sheets(eskisayfa).Name <> "MAKBUZ" Then[/COLOR]
           Sheets(eskisayfa).Name = Cells(a, "D").Value
       a = a + 1
            End If
    Next
  Application.ScreenUpdating = True
End Sub

ASLAN7410 · 20 Ocak 2016

Sayın Vardar Bey ilginiz için çok teşekkür ediyorum.

Kod aşağıdaki satırı sarıya boyuyor.

Sheets(k).Name = Sheets("ANA SAYFA").Cells(a, "D").Value

Sayfanın son halini ekte gönderiyorum, ayrıca bu sayfaların sonuna eklemek istediğim sayfalarada numara veriyor.

Benim istediğim sadece 10 yıllık sayfa adı ile 10 yıllık harcama sayfalarına numara vermesidir. Diğer sayfaları etkilemesini istemiyorum.

Sayfa korumaları şifresizdir.

vardar07 · 20 Ocak 2016

Ana sayfa ve makbuz sayfasından başka sayfa ekleyecek misiniz.

YUSUF44 · 20 Ocak 2016

For i =2 to sheets.count
sheets(i).name=sheets(i).name&"aaaa"
next
For j=2 to sheets.count
sheets(j).name=cells(j+6)
next

ASLAN7410 · 20 Ocak 2016

Sayın Vardar Bey evet başka sayfalarda ekliyeceğim.

Sayın Yusuf Bey aşağıdaki satırı sarıya boyadı ve 2015aaaa, 2016aaaa,.... 2015Haaaa, 2016H aaaa şeklinde yaptı.

Sheets(j).Name = Cells(j + 6)

2015 H, 2016 H gibi isimli sayfalarım harcama sayfası olduğu için bu şekilde ayarlamıştım.

ASLAN7410 · 20 Ocak 2016

Aşağıdaki formülü bu şekilde yapmamım sebebi, D8 hücresine alt sayfalardan birisinin ismini yazdığım zaman aynı sayfadan var dediği için, önce sayfaları harflere göre yazıp sonrada D8 hücresindeki yıllara göre yazdığından bu şekilde yapmıştım.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
Worksheets(2).Name = "a"
Worksheets(3).Name = "b"
Worksheets(4).Name = "c"
Worksheets(5).Name = "d"
Worksheets(6).Name = "e"
Worksheets(7).Name = "f"
Worksheets(8).Name = "g"
Worksheets(9).Name = "h"
Worksheets(10).Name = "ı"
Worksheets(11).Name = "j"
Worksheets(12).Name = "k"
Worksheets(13).Name = "l"
Worksheets(14).Name = "m"
Worksheets(15).Name = "n"
Worksheets(16).Name = "o"
Worksheets(17).Name = "p"
Worksheets(18).Name = "r"
Worksheets(19).Name = "s"
Worksheets(20).Name = "t"
Worksheets(21).Name = "u"

Worksheets(2).Name = Range("D8")
Worksheets(3).Name = Range("D9")
Worksheets(4).Name = Range("D10")
Worksheets(5).Name = Range("D11")
Worksheets(6).Name = Range("D12")
Worksheets(7).Name = Range("D13")
Worksheets(8).Name = Range("D14")
Worksheets(9).Name = Range("D15")
Worksheets(10).Name = Range("D16")
Worksheets(11).Name = Range("D17")
Worksheets(12).Name = Range("D18")
Worksheets(13).Name = Range("D19")
Worksheets(14).Name = Range("D20")
Worksheets(15).Name = Range("D21")
Worksheets(16).Name = Range("D22")
Worksheets(17).Name = Range("D23")
Worksheets(18).Name = Range("D24")
Worksheets(19).Name = Range("D25")
Worksheets(20).Name = Range("D26")
Worksheets(21).Name = Range("D27")
Application.ScreenUpdating = True
End Sub

Sayfa adlarını hücrelerden almak

ASLAN7410

Ekli dosyalar

YUSUF44

Destek Ekibi

ASLAN7410

YUSUF44

Destek Ekibi

ASLAN7410

ASLAN7410

YUSUF44

Destek Ekibi

Ömer BARAN

Uzman

vardar07

Destek Ekibi

YUSUF44

Destek Ekibi

ASLAN7410

ASLAN7410

Ekli dosyalar

YUSUF44

Destek Ekibi

ASLAN7410

vardar07

Destek Ekibi

ASLAN7410

Ekli dosyalar

vardar07

Destek Ekibi

YUSUF44

Destek Ekibi

ASLAN7410

ASLAN7410