Makro ile Sayfa (sheet) ismini değiştirme

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027
CoffeeScript:
Sub ekle()
    Dim YeniSayfaİsmi
    YeniSayfaİsmi = Format(Now, "yymmdd") + "-"
    For i = 1 To Sheets.Count
       If Left(Worksheets(i).Name, 7) = YeniSayfaİsmi Then
          Say = Say + 1
       End If
    Next i
    Sheets("ŞABLON").Copy After:=Sheets(Sheets.Count)
    [BB6].Value = Format(Now, "dd.mm.yyyy")
    ActiveSheet.Name = YeniSayfaİsmi & Say + 1
End Sub

Harikasınız, elinize sağlık.
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
Merhabalar benimde buna benzer bir sorunum var.

Sheets("ŞABLON").Copy After:=Sheets(Sheets.Count)
[BB6].Value = Format(Now, "dd.mm.yyyy")
ActiveSheet.Name = Format(Now, "yymmdd") + "-" + "aynı isim olunca"

aynı isim olunca yerine ne yazmam gerekir. Yapmak istediğimde kopyalamış olduğum ŞABLON sayfamın ismi o günün YIL AY GÜN formatı gibi yymmdd şeklinde fakat aynı tarihte kopyalamada sıkıntı olmaması için yanında yymmdd-1,2,3,4 gibi sıralasın
Merhaba

Saat, dakika formatını da eklerseniz mükerrer sayfa olmaz.
ActiveSheet.Name = Format(Now, "yy.aa.gg ss.dd")
 

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027
@ÖmerFaruk Bey,
Sub sil()

a = ActiveSheet.Name
If a = "ŞABLON" Then
MsgBox "ŞABLON Sayfası Silinemez!"
End If

If a <> "ŞABLON" Then

Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

End If

End Sub

gibi kodu yazdım. İşe de yaradı fakat sayfa sildiğim zaman ekle() makrosu hata veriyor.
CoffeeScript:
Sub ekle()
    Dim YeniSayfaİsmi
    YeniSayfaİsmi = Format(Now, "yymmdd") + "-"
    For i = 1 To Sheets.Count
       If Left(Worksheets(i).Name, 7) = YeniSayfaİsmi Then
          Say = Say + 1
       End If
    Next i
    Sheets("ŞABLON").Copy After:=Sheets(Sheets.Count)
    [BB6].Value = Format(Now, "dd.mm.yyyy")
    ActiveSheet.Name = YeniSayfaİsmi & Say + 1
End Sub
 

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027
Bu arada Ömer Beyi kodu yazdığı için ekledim. @uzmanamele sizin de fikirlerinizi ve yardımlarınızı beklerim.

@ÖmerFaruk Bey,
Sub sil()

a = ActiveSheet.Name
If a = "ŞABLON" Then
MsgBox "ŞABLON Sayfası Silinemez!"
End If

If a <> "ŞABLON" Then

Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

End If

End Sub

gibi kodu yazdım. İşe de yaradı fakat sayfa sildiğim zaman ekle() makrosu hata veriyor.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Kurduğunuz mantık yanlış ya da eksik.

Şöyle ki;
220711-1
220711-2
220711-3

isimli 3 sayfanız olsa ve siz 220711-1 sayfasını sildiğinizde olay elbet karışacak. Dosya benim olsa ve düzene ben karar veriyor olsam elbet çözüm üretirim.
Ama dosya sizin, sayfa isimlerinde kriter ve kıstaslarını nelerdir bilemem.
Çözümlerden birisi.
220711-2 sayfasını sildiğinizde, bir kontrol yapıp eğer sayfalarda 220711-3 ve devamında bir sayfa varsa onların isimlerini değiştirim. Eğer bu işe yarıyacak ve sorunuzu çözecekse SİL makronuzu aşağıdakiyle değiştirin.
Dosyanızın yedeğini almayı unutmayın.

C++:
Sub sil()
   Dim Dict As Object
   ' Tüm sayfa isimlerinizin ŞABLON ve yyaadd-x formatında sayfalar olduğunu varsayıyoruz
   ' Farklı bir sayfa adınız varsa koda ilave yapmak gerekir
   Dim ShName As String
   ShName = ActiveSheet.Name
   If ShName = "ŞABLON" Then MsgBox "ŞABLON Sayfası Silinemez!": Exit Sub
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   If InStr(1, ShName, "-") = 0 Then Exit Sub
   On Error GoTo Bitir
   Do
      k = k + 1
      AraSayfa = Split(ShName, "-")(0) & "-" & Split(ShName, "-")(1) + k
      Worksheets(AraSayfa).Name = Split(ShName, "-")(0) & "-" & Split(ShName, "-")(1) + k - 1
   Loop
   Exit Sub
Bitir:
   On Error GoTo 0
End Sub
 

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027
Kurduğunuz mantık yanlış ya da eksik.

Şöyle ki;
220711-1
220711-2
220711-3

isimli 3 sayfanız olsa ve siz 220711-1 sayfasını sildiğinizde olay elbet karışacak. Dosya benim olsa ve düzene ben karar veriyor olsam elbet çözüm üretirim.
Ama dosya sizin, sayfa isimlerinde kriter ve kıstaslarını nelerdir bilemem.
Çözümlerden birisi.
220711-2 sayfasını sildiğinizde, bir kontrol yapıp eğer sayfalarda 220711-3 ve devamında bir sayfa varsa onların isimlerini değiştirim. Eğer bu işe yarıyacak ve sorunuzu çözecekse SİL makronuzu aşağıdakiyle değiştirin.
Dosyanızın yedeğini almayı unutmayın.

C++:
Sub sil()
   Dim Dict As Object
   ' Tüm sayfa isimlerinizin ŞABLON ve yyaadd-x formatında sayfalar olduğunu varsayıyoruz
   ' Farklı bir sayfa adınız varsa koda ilave yapmak gerekir
   Dim ShName As String
   ShName = ActiveSheet.Name
   If ShName = "ŞABLON" Then MsgBox "ŞABLON Sayfası Silinemez!": Exit Sub
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   If InStr(1, ShName, "-") = 0 Then Exit Sub
   On Error GoTo Bitir
   Do
      k = k + 1
      AraSayfa = Split(ShName, "-")(0) & "-" & Split(ShName, "-")(1) + k
      Worksheets(AraSayfa).Name = Split(ShName, "-")(0) & "-" & Split(ShName, "-")(1) + k - 1
   Loop
   Exit Sub
Bitir:
   On Error GoTo 0
End Sub
Evet maalesef makroya hakim olmadığım için eksikliğini hissediyorum. Öğrenmeye çok hevesliyim fakat kursa gitmeden zor gibi gözüküyor. Bu arada tekrardan elinize sağlık istediğim gibi oldu, bu bana fazla bile gelir. Teşekkürler. 🙏🏻🙏🏻🙏🏻
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Rica ederim.
Zaten şu anda o kurslardan birindesiniz.
 
Üst