Güne göre Sayfa Kopyalama

[ANTALYA 01]

Merhabalar

Aşağıdaki kod ile bir önceki sayfayı kopyalayarak yeni sayfa oluşturmaktayım fakat kopyalanan sayfanın günün tarihini vermesi için koda ne eklemem gerekiyor.
Örnek Kopyalanan sayfa 11.01.2009 Olması gerekiyor (Sheet )Kopya sayfa 1 değil

Sub Sayfa_Kopyala()
Application.DisplayAlerts = False
On Error Resume Next
Cells.Select
Selection.Copy
Sheets("Veriler").Select
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("E9").Select
Sheets("Veriler").Select
Range("A3").Select
Application.CutCopyMode = False
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub Sayfa_Kopyala()
    On Error GoTo Hata
    Application.ScreenUpdating = False
    Cells.Copy
    Sheets("Veriler").Select
    Sheets.Add
    ActiveSheet.Name = Date
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("E9").Select
    Sheets("Veriler").Select
    Range("A3").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Exit Sub
Hata:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Sheets("Veriler").Select
    Range("A3").Select
    Application.ScreenUpdating = True
    MsgBox "Eklemek istediğiniz sayfa bulunmaktadır !", vbCritical
End Sub

 

[ANTALYA 01]

X

Merhabalar

Kodu ekteki çalışmama ekledim run time error 9 Hatası veriyor.
Kodun en son tarihteki sheet adına bakarak bu gün tarihli kopyasını yapmasını istiyorum.sayfadaki herşeyi kopyalarayarak bugün tarihli kopya oluşturması

 

[Korhan Ayhan]

Selamlar,

Siz dosyanızı eklemediğiniz için vermiş olduğunuz kodu tahmine göre düzenlemiştim. Aşağıdaki kodu denermisiniz.

Sub Sayfa_Kopyala()
    On Error GoTo Hata
    Application.ScreenUpdating = False
    Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Date
    [E3] = Date
    [A5:E30].ClearContents
    Application.ScreenUpdating = True
    Exit Sub
Hata:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Eklemek istediğiniz sayfa bulunmaktadır !", vbCritical
End Sub