Automatisierung Fehler beim Löschen des Blattes

Question

Ich habe diesen Code, der ein neues Blatt erstellt und es verbirgt, um die historischen Daten zu behalten, aber ich muss alle Blätter älter als einen Monat löschen, um zu vermeiden, dass mein Arbeitsblatt zu groß wird.

Ich habe versucht, meine für von 30 bis 60 und 60 bis 30 bereits zu zählen.

Sub Historico_DAR() 

' Historico_DAR Macro 

    Dim LDate, PDate As String 
    Dim ws As Worksheet 
    Dim wks As Worksheet 
    Dim i As Integer 

    LDate = Format(DateSerial(Year(Date), Month(Date), Day(Now)), "dd-mmm-yy") 
    PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - 30), "dd-mmm-yy") 
    Worksheets("Sheet69").Range("A1").Value = PDate 

'CODE Giving Atomation Error, the rest is OK 

    For Each wks In Worksheets 
     For i = 60 To 30 Step -1 
     PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - i), "dd-mmm-yy") 
      If wks.Name = PDate Then 
       Application.DisplayAlerts = False 
       Sheets(PDate).Delete 
       Application.DisplayAlerts = True 
      End If 
     Next 
    Next 

'End of the code giving me problems 

    For Each ws In Worksheets 
     If ws.Name = LDate Then 
     Application.DisplayAlerts = False 
     Sheets(LDate).Delete 
     Application.DisplayAlerts = True 
     End If 
    Next 

    Sheets("Atual").Select 
    Sheets("Atual").Copy Before:=Sheets(9) 
    Worksheets("Atual (2)").Range("A1:P476").Value = Worksheets("Atual").Range("A1:P476").Value 
    Sheets("Atual (2)").Select 
    Sheets("Atual (2)").Name = LDate 
    Sheets(LDate).Visible = False 
End Sub 

Answer 1

Dies kann eine Zeit, als On Error Resume Next tatsächlich nützlich ist.

On Error Resume Next 
Application.DisplayAlerts = False 
For i = 60 To 30 Step -1 
    PDate = Format(Date - i, "dd-mmm-yy") 
    Sheets(PDate).Delete 
Next i 
Application.DisplayAlerts = True 
On Error GoTo 0 

Befreien Sie sich vollständig von der Arbeitsblattschleife.

Answer 2

Nur für den Fall, dass Sie Urlaub machen und es länger als zwei Monate her ist, dass Sie alte Blätter gelöscht haben, können Sie über 30 Tage (und nicht nur die zwischen 30 und 60 Tage alten) löschen Name selbst in den Zustand:

For Each wks In Worksheets 
    If IsDate(wks.Name) Then 
     If (Date() - 30) > CDate(wks.Name) Then 
      Application.DisplayAlerts = False 
      wks.Delete 
      Application.DisplayAlerts = True 
     End If 
    End If 
Next 

---

Und dies mit der nächsten Schleife kombiniert werden, um die If

For Each wks In Worksheets 
    If IsDate(wks.Name) Then 
     If (Date() - 30) > CDate(wks.Name) Or Date() = CDate(wks.Name) Then 
      Application.DisplayAlerts = False 
      wks.Delete 
      Application.DisplayAlerts = True 
     End If 
    End If 
Next 

---

durch die Erweiterung

Beachten Sie auch, dass

LDate = Format(DateSerial(Year(Date), Month(Date), Day(Now)), "dd-mmm-yy") 
PDate = Format(DateSerial(Year(Date), Month(Date), Day(Now) - 30), "dd-mmm-yy") 

kann vereinfacht werden entweder

LDate = Format(Date(), "dd-mmm-yy") 
PDate = Format(Date() - 30, "dd-mmm-yy") 

oder

LDate = Format(Now(), "dd-mmm-yy") 
LDate = Format(Now() - 30, "dd-mmm-yy")