Sayfa çoğaltma

[ASLAN7410]

Merhaba.

Ekte gönderdiğim excel dosyamda aşağıdaki kod mevcut, butona bastığımda sayfa çoğaltıyor.

Sub sayfa_kopyala()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
say = ActiveWorkbook.Sheets.Count
Sheets(ActiveSheet.Name).Select
Sheets(ActiveSheet.Name).Copy After:=Sheets(say)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sayfalarım yıl isimleri, yapmak istediğim sayfa üzerindeki butona bastığımda bir sonraki yılın ismi ile sayfayı hemen yanına sol tarafa çoğaltmasını istiyorum.

Örneğin 2019 sayfasındaki butona bastığımda hemen soluna 2020 sayfası oluşsun, 2018 sayfasındaki butona bastığımda 2019 sayfası olduğu için bu sayfa zaten var şeklinde uyarı vermesini istiyorum.
Yardımcı olur musunuz?

 

[ASLAN7410]

Forumda Sayın Korhan Bey'in yazmış olduğu aşağıdaki kodu buldum, bu gayet güzel çalışıyor, ellerine sağlık.

Sayfa isimleri rakam olması şartı eklemeye çalıştım olmadı.
Birde bu eklemiş olduğu sayfayı ilk başa eklerse daha iyi olacak.

Yardımcı olur musunuz?

Option Explicit
Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant
  
    SAYFA_ADI = Application.InputBox("Sayfa ismini giriniz.")
  
    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If
  
    If SAYFA_ADI = "" Then
    MsgBox "Lütfen sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If
  
    Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
  
    On Error GoTo Devam
    ActiveSheet.Name = SAYFA_ADI
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Exit Sub
  
Devam:
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfa_Kopyala()
    Dim Sayfa_Adi As Integer
    On Error Resume Next
    Sayfa_Adi = ActiveSheet.Name
    If Err.Number = 13 Then
        MsgBox "Sayfa adı numerik değildir. Kontrol ediniz!", vbCritical
        Exit Sub
    End If
    ActiveSheet.Copy Before:=Sheets(ActiveSheet.Index)
    On Error GoTo 10
    ActiveSheet.Name = Sayfa_Adi + 1
    Exit Sub
10
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub

 

[ASLAN7410]

Sayın Korhan Bey ellerinize sağlık, çok teşekkür ediyorum.

Hayırlı günler diliyorum.

 

[gurayavci]

Merhaba

Aynı örnek üzerinde yeni sayfa eklediğimde örnekteki gibi sola değil sağa doğru sayfayı kopyalamasını ve sayfa adına +1 eklemesini istiyorum fakat Sayfa adı hem alfabetik hem numerik (Box- 1) şeklinde Box- 2 Box- 3 şeklinde ilerlemesini istiyorum , gönderdiğiniz formülü düzenlemeye çalıştım fakat yönü sağa çevirmeyi ve ismin sonundaki rakamı değiştirmeyi çözemedim.

 

[YUSUF44]

Merhaba

Aynı örnek üzerinde yeni sayfa eklediğimde örnekteki gibi sola değil sağa doğru sayfayı kopyalamasını ve sayfa adına +1 eklemesini istiyorum fakat Sayfa adı hem alfabetik hem numerik (Box- 1) şeklinde Box- 2 Box- 3 şeklinde ilerlemesini istiyorum , gönderdiğiniz formülü düzenlemeye çalıştım fakat yönü sağa çevirmeyi ve ismin sonundaki rakamı değiştirmeyi çözemedim.

Örnek dosya paylaşır mısınız?

 

[gurayavci]

Yusuf bey sayfa adı ile ilgili talebimi başka şekilde çözdüm (Sayfa adını numerik yaptım(1-2-3)) fakat örnekte, düğmeye tıklayınca sayfalar sola doğru açılıyor, sağa doğru açılması için yardımcı olabilirmisiniz

 

[YUSUF44]

Kodda

ActiveSheet.Copy before:=Sheets(ActiveSheet.Index)


satırında before yerine after kullanmayı deneyin.

Eğer mevcut sayfanın sağında değil de en sonda olmasını isterseniz ActiveSheet.Index yerine Sheets.Count kullanabilirsiniz.

 

[gurayavci]

Teşekkürler Yusuf bey, oldu. Ben After yerine Next yazıyordum...
teşekkür ederim