Otomatik Adlandırma

[iplikci_80]

Burada "HAZİRAN" sayfasını taşıyıp kopyalama yaptığımda yeni sayfanın "TEMMUZ, AĞUSTOS… vs" otomatik olarak adlandırılmasını sağlamak istiyorum.

 

[hamitcan]

Kodu, Dosyanın ThisWorkBook kısmına ekleyin.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    arr = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
    For i = 0 To UBound(arr)
        If arr(i) = Sh.Previous.Name Then
            Sh.Name = arr(i + 1)
            Sh.Previous.Cells.Copy Sh.[a1]
        End If
    Next
End Sub

 

[iplikci_80]

Sayın hamitcan ilginize teşekkür ederim. Verdiğiniz kodu ekledim ama isimler değişmiyor. Mayıs ise mayıs(2) oluyor.

 

[hamitcan]

Taşı veya Kopyala yapmayacaksınız, sadece sayfa ekleyeceksiniz.

 

[hamitcan]

Sayfa isimlerinin kod içindeki yazılışları ile aynı olmasına dikkat ediniz.

 

[iplikci_80]

Dediğiniz gibi sadece sayfa eklemeye çalıştım EK'teki mesajı aldım.

 

[hamitcan]

Dosyayı inceleyin.

 

[iplikci_80]

İlginize çok teşekkür ederim. Sayfa eklerken olduğu gibi kopyalanmasını sağlamak mümkün mü? Çünkü sayfa yapısı bozuluyor.

 

[iplikci_80]

Arkadaşlar yardımlarınızı rica ediyorum.

 

[hamitcan]

Kodu sayfa içinde bir butona bağlayıp kullanabilirsiniz.

Sub TasiKopyala()
    ActiveSheet.Copy Before:=Sheets(1)
    arr = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
    For i = 0 To UBound(arr)
        If arr(i) = ActiveSheet.Next.Name Then
            ActiveSheet.Name = arr(i + 1)
        End If
    Next
End Sub

 

[iplikci_80]

Buton ekleyerek yaptım ama HAZİRAN, TEMMUZ, AĞUSTOS .... sağa doğru sıralayıp gitmesi gerekirken sola doğru AĞUSTOS, TEMMUZ, HAZİRAN gibi sıralıyor.

 

[hamitcan]

Ben olsam o kadar takmazdım. Kodu burada değiştirdim bir de böyle deneyin.

Sub TasiKopyala()
    ActiveSheet.Copy After:=Sheets(1)
    arr = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
    For i = 0 To UBound(arr)
        If arr(i) = ActiveSheet.Previous.Name Then
            ActiveSheet.Name = arr(i + 1)
        End If
    Next
End Sub

 

[iplikci_80]

İlginize teşekkür ederim.