Paylaşılan Dosyada Günün tarihi ile Sheet açma

[vein03051976]

Merhaba

Ekteki paylaşılan dosyada personeller günlük araç taleplerini giriyorlar.

Ama "paylaşılan ikili çalışma dosyası" olduğu için ertesi gün yeni bir sheet oluşturmak ancak, Boş sheet ekle+ Kopyala yapıştır ile oluyor. Buda sorun oluyor

İstediğimiz:

1- Bir butona tıklandığında,
2- Kişi adları ve başlıklara kalacak diğer bilgiler temizlenecek,
3- Dosyadaki sheet adı formatı gibi sıradan devam edecek şekilde olacak ( Gün/Ay/Yıl )
4- yeni bir sheet
5- otomatik oluşabilirmi

İyi çalışmalar

 

[asi_kral]

Merhaba
İStediğiniz bunun gibi bir şey mi?

Sub s_aç()
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("x")
S1.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Date
End Sub

 

[vein03051976]

Merhaba
İStediğiniz bunun gibi bir şey mi?

Sub s_aç()
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("x")
S1.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Date
End Sub

Merhaba

Teşekkürler kopyalama oldu ama ekteki hatayı verdi ve sheet adı 15.03.2022 olarak değişmedi

 

[asi_kral]

Aynı sayfa adından var ise kopya oluşturur ama açamaz aynı sayfadan sadece 1 adet olabilir.

 

[vein03051976]

Aynı sayfa adından var ise kopya oluşturur ama açamaz aynı sayfadan sadece 1 adet olabilir.

Sheet numarası en son 14.03.2022 de

tıkladım 15.03.2022 olarak yeni bir tane açamaz mı?

her tıkladığımda +1 açmasını istiyorum.

 

[asi_kral]

Merhaba
Bu kodu dener misiniz?

Sub s_aç()
Dim S1 As Worksheet, S2 As Worksheet, SYF As Long, STR As Long
Set S1 = Sheets("x")
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "xxEngel"
Set S2 = Sheets("xxEngel")
STR = 1
For SYF = 1 To Sheets.Count
If Sheets(SYF).Name <> "yyy" And Sheets(SYF).Name <> "x" And Sheets(SYF).Name <> "xxEngel" Then
S2.Cells(STR, "A") = DateSerial(Right(Sheets(SYF).Name, 4), Month(Mid(Sheets(SYF).Name, 4, 2)), Left(Sheets(SYF).Name, 2))
STR = STR + 1
End If
Next
STR = WorksheetFunction.Max(S2.Range("A:A")) + 1
S1.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Format(STR, "dd.mm.yyyy")
Application.DisplayAlerts = False
S2.Delete
Application.DisplayAlerts = True
End Sub

 

[vein03051976]

Merhaba
Bu kodu dener misiniz?

Sub s_aç()
Dim S1 As Worksheet, S2 As Worksheet, SYF As Long, STR As Long
Set S1 = Sheets("x")
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "xxEngel"
Set S2 = Sheets("xxEngel")
STR = 1
For SYF = 1 To Sheets.Count
If Sheets(SYF).Name <> "yyy" And Sheets(SYF).Name <> "x" And Sheets(SYF).Name <> "xxEngel" Then
S2.Cells(STR, "A") = DateSerial(Right(Sheets(SYF).Name, 4), Month(Mid(Sheets(SYF).Name, 4, 2)), Left(Sheets(SYF).Name, 2))
STR = STR + 1
End If
Next
STR = WorksheetFunction.Max(S2.Range("A:A")) + 1
S1.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Format(STR, "dd.mm.yyyy")
Application.DisplayAlerts = False
S2.Delete
Application.DisplayAlerts = True
End Sub

Merhaba Ellere sağlık

Verdiğiniz kod ile "günler" sıradan devam etti ama "Aylar" etmedi.

Birde şöyle bir durum var "ikili çalışma kitabı" yaparsam ekteki hatayı alıyorum