Herhalen van VBA code meerdere werkbladen geeft foutmelding.

[AEHofman]

Hoi

Ik heb meerdere werkbladen(dagen in de week) waarbij ik indien ik, onderstaande code laat lopen dit geen problemen geeft.
Nu wil ik middels één druk op de knop dezelfde code uitvoeren op meerdere bladen "weekvariant" Blad ma, di, wo, do, vr, za, zo.
Bij het compileren geeft VBA een foutmelding "compileerfout Dubbele declaratie in het huidige bereik. Is dit op te lossen en zo ja hoe.?

Andrys

ActiveSheet.Unprotect Password:="mOHW"
Application.ScreenUpdating = False
Dim a As Range, c As Range, s As String
s = "BP8:BP157" 'de bereiken die moeten gecontroleerd worden
Application.ScreenUpdating = False
For Each a In Range(s)
For Each c In a
c.EntireRow.Hidden = (c.Value >= 10000)
Next c
Next a
Application.GoTo Range("A1"), True
ActiveWindow.VisibleRange(1, 1).Select
ActiveSheet.Protect Password:="mOHW"
Application.ScreenUpdating = True
Private Sub CommandButton2_Click()
Unload Me

Voorbeeld weekvariant:

Sheets("ma").Select
ActiveSheet.Unprotect Password:="mOHW"
Application.ScreenUpdating = False
Dim a As Range, c As Range, s As String
s = "BP8:BP157" 'de bereiken die moeten gecontroleerd worden
Application.ScreenUpdating = False
For Each a In Range(s)
For Each c In a
c.EntireRow.Hidden = (c.Value >= 10000)
Next c
Next a
Application.GoTo Range("A1"), True
ActiveWindow.VisibleRange(1, 1).Select
ActiveSheet.Protect Password:="mOHW"
Application.ScreenUpdating = True
Sheets("di").Select
ActiveSheet.Unprotect Password:="mOHW"
Application.ScreenUpdating = False
Dim a As Range, c As Range, s As String
s = "BP8:BP157" 'de bereiken die moeten gecontroleerd worden
Application.ScreenUpdating = False
For Each a In Range(s)
For Each c In a
c.EntireRow.Hidden = (c.Value >= 10000)
Next c
Next a
Application.GoTo Range("A1"), True
ActiveWindow.VisibleRange(1, 1).Select
ActiveSheet.Protect Password:="mOHW"
Application.ScreenUpdating = True
Etc. voor wo t/m zo

 

[edmoor]

Maak eerste de code eens op want zo is het niet te volgen. Zet er dus codetags omheen en zorg dat de inspringpunten op de juiste plek staan. Zet ook de regels met Sub en End Sub erbij.

 

[Elsendoorn2134]

Andrys,

Met een for...next loop kun je alle sheets afgaan binnen een workbook, hierbij een voorbeeld.
Let wel dat hij alle sheets afgaat dus ook een tabblad met de naam "Totaal" wordt dan meegenomen.
Eventueel moet je deze dan uitsluiten.

Veel Succes.

Sub BewerkBladen()

Application.ScreenUpdating = False
Dim a As Range, c As Range, s As String
Dim MySheet As Worksheet

For Each MySheet In ActiveWorkbook.Sheets

    ActiveSheet.Unprotect Password:="mOHW"

    s = "BP8:BP157" 'de bereiken die moeten gecontroleerd worden

    For Each a In Range(s)
        For Each c In a
            c.EntireRow.Hidden = (c.Value >= 10000)
        Next c
    Next a
Next MySheet

Application.GoTo Range("A1"), True
ActiveWindow.VisibleRange(1, 1).Select
ActiveSheet.Protect Password:="mOHW"
Application.ScreenUpdating = True

End Sub

 

[AEHofman]

Dit is de oplossing waar ik naar zocht
Bedankt voor de snelle reacties, het lijkt Arjen Robben wel.

Groet Andrys