Macro uitvoeren op alle sheets behalve op 3 sheets

[vrouw]

Hallo,

Ik heb onderstaande geproduceerd om uit te voeren op alle 30 sheets. Echter moet dat niet gebeuren op de sheets Totaal op sheet Basis en op de sheet Berekening.

Hoe kan ik die exeptions hiervoor uitvoeren?

Private Sub Workbook_Open()

For Each Sh In ActiveWorkbook.Sheets

If Sh.Visible Then

Sh.Activate

Range("A14") = "% inkoop"

Range("B14,C14,D14") = "=R[-2]C/R[-3]C*100"

End If

Next

End Sub

 

[AHulpje]

Private Sub Workbook_Open()
    For Each sh In ActiveWorkbook.Sheets
        With sh
            If .Visible And .Name <> "Totaal" And .Name <> "Basis" And .Name <> "Berekening" Then
                .Range("A14") = "% inkoop"
                .Range("B14,C14,D14") = "=R[-2]C/R[-3]C*100"
            End If
        End With
    Next
End Sub

 

[vrouw]

Thanks @AHulpje dat doet idd wat het moet doet

Nu heb ik apart in This Workbook deze code staan. (om sheet de naam te geven dat in A* op de sheet staat)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Target, Range("A8")) Is Nothing Then Sh.Name = Range("A8").Text
On Error GoTo 0
End Sub

Is dat te integreren in de eerste macro?

 

[HSV]

Kijk maar of het hiermee kan.

Private Sub Workbook_Open()
Dim sh As Worksheet
    For Each sh In Sheets
        With sh
            If .Visible And .Name <> "Totaal" And .Name <> "Basis" And .Name <> "Berekening" Then
               .name = iif(.range("a8")<>"",.range("a8"),.name)
                .Range("A14") = "% inkoop"
                .Range("B14:D14") = "=R[-2]C/R[-3]C*100"
            End If
        End With
    Next
End Sub

 

[AHulpje]

Dus als je A8 wijzigt moet het betreffende werkblad automatisch de naam krijgen die in A8 staat. Ik weet niet precies wat je bedoeling is, maar dat gebeurt met de oplossing van HSV dus niet meer direct, tenzij je de Workbook_SheetChange gebeurtenis behoudt.