Yeni sayfa oluşturma

[ANTALYA 01]

Sub YeniKasaAç()
On Error Resume Next
ilktarih = ActiveSheet.Name
sontarih = DateSerial(Year(ilktarih), Month(ilktarih), Day(ilktarih)) + 1

ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Select
ActiveWindow.ActiveSheet.Name = sontarih
Range("C7").Formula = "=" & ilktarih & "!F37"

Range("B8").Select
End Sub

Merhaba
Ben bu kodla Sayfayı Kopyalatabiliyorum.Fakat Kopyalandığında yeni sayfa oluştuğunda Sayfa Adı Bir gün artarak Yani 06/10/2007-07/10/2007 Gibi Kopyalasın ve Kopyalanan Sayfada Örnekte gösterdiğim Renkli yerler silinsin hazır doldurulacak hale gelsin.

 

[Ferhat Pazarçevirdi]

Kodunuzu aşağıdaki gibi değiştiriniz

Sub YeniKasaAç()
gun = Left(ActiveSheet.Name, 2)
ay = Mid(ActiveSheet.Name, 4, 2)
yil = Mid(ActiveSheet.Name, 7, 4)
yenitarih = DateAdd("d", 1, CDate(gun & "." & ay & "." & yil))
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = yenitarih & "" Then: MsgBox "Bu isimde bir sayfa zaten var", vbCritical, "UYARI": Exit Sub
Next
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Select
ActiveWindow.ActiveSheet.Name = yenitarih
Range("A5:H12").ClearContents
Range("B23:B32").ClearContents
Range("G3") = "TARİH " & yenitarih
[COLOR=green]'Range("C7").Formula = "=" & ilkTarih & "!F37"[/COLOR]
Range("B8").Select
End Sub

 

[hamitcan]

Noteneme fırsatım olmadı.

Sub YeniKasaAç()
'On Error Resume Next
Dim ilktarih As String
ilktarih = Format(Replace(ActiveSheet.Name, ".", "/"), "00000")
sontarih = Format(ilktarih + 1, "dd.mm.yyyy")
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Select
ActiveWindow.ActiveSheet.Name = sontarih
Range("C7").Formula = "=" & ilktarih & "!F37"

Range("B8").Select
End Sub

 

[ANTALYA 01]

W

Teşekkür ederim.Tam istediğim gibi olmuş