Automatisch cellen leegmaken na verloop van tijd

  • Onderwerp starter Onderwerp starter Remlo
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

Remlo

Gebruiker
Lid geworden
20 mei 2011
Berichten
149
Hallo,
Volgende macro heb ik opgenomen om cellen uit een weekrooster leeg te maken.
Mijn vraag is nu, is het mogelijk dit te automatiseren. Bedoeling is dat hij de ingevulde cellen automatisch zou leegmaken na 3 maanden.
Het bestand heeft per week een tabblad (WK1,WK2,enz...) waarbij de datum steeds in cel D8 staat.

opgenomen macro;

Sub LeegmakenOudeWeken()
'
' LeegmakenOudeWeken Macro
'
'
ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
Selection.ClearContents
Range("D10:F10").Select
End Sub
 
Dat kun je doen in de Workbook_Open sectie. Je opgenomen macro maakt echter alleen de actieve cel leeg en uit je vraag begrijp ik dat de waarde van de cellen met validatie op alle sheets leeg gemaakt moet worden.

Code:
Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim cs As String
    
    cs = ActiveSheet.Name
    For Each ws In Worksheets
        ws.Activate
        '3 maanden = 13 weken = 91 dagen
        If Date - Range("D8") > 91 Then
            For Each cell In ActiveSheet.UsedRange.Cells
                On Error Resume Next
                cell.SpecialCells(xlCellTypeAllValidation).ClearContents
                On Error GoTo 0
            Next
        End If
    Next ws
    Sheets(cs).Activate
End Sub
 
Laatst bewerkt:
Edmoor,

bedankt voor je snelle reactie.
Het gaat inderdaad om meerdere tabbladen...
Echter heb ik een fout gemaakt bij het vermelden van de tabbladen, de weken gaan inderdaad van WK1 tot WK53 (en op deze bladen zou de inhoud moeten gewist worden) maar er zijn er nog andere.
Toen ik domweg je code overnam liep Excel vast. Hoe kan ik enkel de juiste tabbladen WK1-WK53 laten selecteren in je code. Heb zelf nog niet veel verstand van VBA
 
Zijn dat ook de enige bladnamen die met de letters WK beginnen? Dan kun je dit doen:

Code:
Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim cs As String
    
    cs = ActiveSheet.Name
    For Each ws In Worksheets
        If Left(ws.Name, 2) = "WK" Then
            ws.Activate
            '3 maanden = 13 weken = 91 dagen
            If Date - Range("D8") > 91 Then
                For Each cell In ActiveSheet.UsedRange.Cells
                    On Error Resume Next
                    cell.SpecialCells(xlCellTypeAllValidation).ClearContents
                    On Error GoTo 0
                Next
            End If
        End If
    Next ws
    Sheets(cs).Activate
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan