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.

 

[vrouw]

@AHulpje Je bedoeld dat dat beter niet geintegreed kan worden in de code van @HSV?

Dat is wel jammer want als het bewerkt word dan word dat idd niet mee meegenomen

 

[AHulpje]

Je zou je Workbook_SheetChange zo kunnen aanpassen:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, Range("A8")) Is Nothing Then Exit Sub
    With Sh
        If .Name <> "Totaal" And .Name <> "Basis" And .Name <> "Berekening" Then .Name = Range("A8").Text
    End With
    On Error GoTo 0
End Sub

 

[HSV]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 On Error Resume Next
 If Not Intersect(Target, Range("A8")) Is Nothing Then If InStr(1, "totaal,basis,berekening", Sh.Name, 1) = 0 Then Sh.Name = Target
End Sub

 

[AHulpje]

Als je wilt dat het werkblad direct van naam wijzigt zodra je cel A8 wijzigt, behalve voor de drie genoemde werkbladen, dan moet je de Workbook_Sheetchange handhaven en aanpassen. En dan kun je kiezen uit #7 of #8.

Als je het goed vindt dat na het wijzigen van cel A8 de werkbladnaam pas wordt aangepast als het bestand opnieuw geopend wordt dan is de oplossing van HSV in #4 prima. Aan jou de keuze.