looping door tabbladen

Status
Niet open voor verdere reacties.
J

JanBG

Verenigingslid
Lid geworden
30 aug 2017
Berichten
942
Hoi,

Ik heb een roosterbestand waar allerlei vaste gegevens automatisch in het bezettingsoverzicht worden ingevuld. Leidinggevenden kunnen via een USERFORM invullen welke medewerker wanneer afwezig is (verlof, cursus, vakantie enzovoorts). Deze gegevens worden in verschillende tabbladen opgeslagen (januari t/m december) en vanuit die tabbladen in het bezettingsoverzicht gezet.
Als er een nieuw jaar gekozen wordt, moeten de tabbladen waarin het verlof/afwezigheid van het oude jaar gewist worden. Daar gebruik ik nu deze code voor:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

If MsgBox("Weet je het zeker? Alle verlofinformatie wordt gewist!", vbYesNo + vbQuestion, "ATTENTIE!") = vbNo Then Exit Sub

If Target.Address = "$O$1" Then Sheets("Januari").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Februari").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Maart").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("April").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Mei").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Juni").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Juli").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Augustus").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("September").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("Oktober").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("November").Range("B3:AF20").ClearContents
If Target.Address = "$O$1" Then Sheets("December").Range("B3:AF20").ClearContents
End Sub

Ik wil hier eigenlijk een loop voor gebruiken, maar kom er niet uit hoe dat te doen, zonder dat ook andere tabbladen in het bestand geleegd worden, wat niet de bedoeling is.

Begrijp mij goed, bovenstaande code werkt prima, maar "het ziet er gewoon niet uit"
 
Zoiets?
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    maanden = "Februari|Maart|April|Mei|Juni|Juli|Augustus|September|Oktober|November|December"

    If Target.Address = "$O$1" Then
        If MsgBox("Weet je het zeker? Alle verlofinformatie wordt gewist!", vbYesNo + vbQuestion, "ATTENTIE!") = vbNo Then Exit Sub
        For Each sh In ThisWorkbook.Sheets
            If InStr(1, maanden, sh.Name) > 0 Then sh.Range("B3:AF20").ClearContents
        Next sh
    End If
End Sub
 
Laatst bewerkt:
of met GetCustomListContents

Code: 
Sub VenA()
ar = Application.GetCustomListContents(4)
For j = 1 To 12
  Sheets(ar(j)).Range("B3:AF20").ClearContents
Next j
End Sub
 
Alleen zit er een maand (Januari) teveel in ;)
Tellertje dus wel even aanpassen.
 
@edmoor,
Code: 
If Target.Address = "$O$1" Then Sheets("Januari").Range("B3:AF20").ClearContents

Moet toch ook leeg?
 
Je hebt helemaal gelijk, ik had een regel teveel verwijderd na het kopiëren.
Slip of the finger ;)
 
@edmoor,

Aangepast, maar volgens mij was het "te weinig" ;)
 
Wat ik al zei, ik zat fout :)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan