Sub uitvoeren wanneer men op tabblad klikt

[tijmen_4real]

Goedemorgen,

Ik heb een functie (sub) gevonden en naar wens aangepast die een tabblad kopieërt aan de hand van een ingegeven nummer (aantal).
Deze staat in een tabblad genaamd "kruisjeskaart":

Sub Create()
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xActiveSheet = ActiveSheet
    xNumber = Sheets("procentenlijst").Range("C11").Value - 1
    'InputBox ("Vul het aantal benodigde kruisjeskaarten in") - 1
    For I = 1 To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = "Kruisjeskaart - " & I + 1
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End Sub

Dit werkt prima wanneer ik deze in de VBA-editor laat uitvoeren.
Nu wil ik dat deze sub uitgevoerd wordt wanneer men op tabblad "procentenlijst" een waarde (getal) invoert in cel C11
Wanneer C11 leeg is, moet er niets gebeuren.

Een simpele if-else statement lijkt de makkelijkste, normale optie, maar hoe?
Ik kan helaas het betreffende bestand niet uploaden (bedrijfsgevoelige informatie)
Alle hulp hierbij is van harte welkom!

Bedankt en groet,

Tijmen

 

[SjonR]

als je deze achter het tabblad "procentenlijst zet?

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address(0, 0) = "C11" And IsNumeric(Target) Then
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xActiveSheet = ActiveSheet
    xNumber = Sheets("procentenlijst").Range("C11").Value - 1
    'InputBox ("Vul het aantal benodigde kruisjeskaarten in") - 1
    For I = 1 To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = "Kruisjeskaart - " & I + 1
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End If
End Sub

 

[tijmen_4real]

Met andere code samen is het op dat tabblad dan zo:

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "*****"
Application.ScreenUpdating = False

'allergeen? Zo ja: stip tonen
    If Range("C8").Value = "Ja" Then
                Rows("2").EntireRow.Hidden = False
                Rows("3").EntireRow.Hidden = True
    ElseIf Range("C8").Value = "Nee" Then
                Rows("2").EntireRow.Hidden = True
                Rows("3").EntireRow.Hidden = False
    End If
 
If Intersect(Target, Range("C5:C6")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True

Application.ScreenUpdating = True
If Target.Address(0, 0) = "C11" And IsNumeric(Target) Then
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xActiveSheet = ActiveSheet
    xNumber = Sheets("procentenlijst").Range("C11").Value - 1
    'InputBox ("Vul het aantal benodigde kruisjeskaarten in") - 1
    For I = 1 To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = "Kruisjeskaart - " & I + 1
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End If

ActiveSheet.Protect "*****"

End Sub

Maar dit doet helaas weinig.
Heb ik deze code hier niet goed ingepast?

 

[SjonR]

deze regel zorgt ervoor dat hij niet verder gaat, dus die "bijt" je code daaronder.

If Intersect(Target, Range("C5:C6")) Is Nothing Then Exit Sub

 

[SjonR]

Probeer het zo eens:

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "*****"
Application.ScreenUpdating = False

'allergeen? Zo ja: stip tonen
    If Range("C8").Value = "Ja" Then
                Rows("2").EntireRow.Hidden = False
                Rows("3").EntireRow.Hidden = True
    ElseIf Range("C8").Value = "Nee" Then
                Rows("2").EntireRow.Hidden = True
                Rows("3").EntireRow.Hidden = False
    End If
 
If Intersect(Target, Range("C5:C6")) Is Nothing Then
If Target.Address(0, 0) = "C11" And IsNumeric(Target) Then
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xActiveSheet = ActiveSheet
    xNumber = Sheets("procentenlijst").Range("C11").Value - 1
    'InputBox ("Vul het aantal benodigde kruisjeskaarten in") - 1
    For I = 1 To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = "Kruisjeskaart - " & I + 1
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End If
Exit Sub
End If

Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
Application.ScreenUpdating = True


ActiveSheet.Protect "*****"

End Sub

 

[tijmen_4real]

Code werkt bij invoeren van C11, maar daarna wordt ook het huidige tabblad (procentenlijst) gekopieërd?