Ekte sunduğum tabloda otomatik ay açma işlemi yapmak istiyorum..
Daha önce farkli tabloda sizlerden yardım almıştım..

Private a As Integer, b As Integer, d As Integer
Sub yeniay()
Dim tarih As Date, i As Integer, isim As String
a = InputBox("Lütfen Yeni Ay Tanımlayınız", "zirvem gıda", Month(Date) + 1)
b = Sheets.Count
isim = "zirvem gıda"
If a = 0 Then GoTo 10
Sheets(10).Copy before:=Sheets(3)
ActiveSheet.Name = "Şablon"
Union(Range("j1:m1"), Range("j23:m23"), Range("b45:m49")).ClearContents
Application.DisplayAlerts = False
For i = b To 1 Step -1
If IsNumeric(Left(Sheets(i).Name, 1)) Then
Sheets(i).Delete
End If
Next i
d = CInt(Left(DateSerial(Year(Date), a + 1, "01") - 1, 2))
tarih = DateSerial(Year(Date), a, "01")
tarih1 = Format(tarih, "dd.mm.yyyy")
Union(Range("j1:m1"), Range("j12:m12"), Range("j23:m23"), Range("b45:m49")).ClearContents
For i = 1 To d
Sheets("Şablon").Copy before:=Sheets("Şablon")
ActiveSheet.Name = CStr(tarih1)
Union(Range("j1:m1"), Range("j12:m12"), Range("j23:m23")).Value = tarih
Range("b49").Value = isim
tarih = tarih + 1
tarih1 = Format(tarih, "dd.mm.yyyy")
Next i
10
Sheets("Şablon").Delete
On Local Error Resume Next
Sheets("toplam").Range("d1").Value = _
DateSerial(Year(Date), a, "01") & "-" & DateSerial(Year(Date), a, d) & " " & Replace(UCase(Format(DateSerial(Year(Date), a, "01"), "mmmm")), "i", "İ") & " " & "AYI SATIŞ RAPORLARI"
If Err.Number = 1004 Then
MsgBox "Sayfanız korumalı olduğundan " & vbLf & _
"Toplam sayfasındaki tarih bilgisi değiştirilememiştir.", _
vbInformation, "zirvem gıda"
End If
Sheets("Toplam").Activate
MsgBox "Yeni Ay Açma İşlemi Tamamlandı", vbInformation, isim
Application.DisplayAlerts = True: isim = vbNullString
tarih = Empty: i = Empty: a = Empty: b = Empty: d = Empty
End Sub

Ek Dosyalar

1.AY OCAK 2012 TAHSİLAT VE KM TAKİP.rar(100.57 KB)