Opgelost VBA kopieërd de dropdown niet goed

[joh88]

Ik heb een vba code waarin als er een rij word ingevoegd de opmaak van rij 13 daarin word meegenomen.
in cel A13 zit een dropdown menu met een een reeks waarde.
eerst werkte deze goed. Maar daarna zijn er nog aanpassingen gemaakt in het dropdown menu, er zijn waarden aan toegevoegd maar dat kopieërt hij niet in de VBA.

Private Sub CommandButton1_Click()
' Vraag de gebruiker om het rijnummer waar de nieuwe rij moet worden ingevoegd
Dim doelRij As Variant
doelRij = InputBox("Voer het rijnummer in waaronder de nieuwe activiteit moet worden ingevoegd:", "Rijnummer")

' Controleer of de gebruiker annuleert (lege invoer of op Annuleren klikken)
If doelRij = "" Then
MsgBox "Geannuleerd. Geen rijnummer ingevoerd.", vbInformation
Exit Sub
End If

' Controleer of de ingevoerde waarde geldig is
If IsNumeric(doelRij) Then
' Voeg een nieuwe rij toe onder het opgegeven rijnummer
Rows(doelRij + 1 & ":" & doelRij + 1).Insert

' Kopieer de opmaak van rij 13 naar de nieuwe rij
Rows(13).Copy
Rows(doelRij + 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False ' Schakel knippen/kopiëren modus uit

' Handmatig instellen van gegevensvalidatie (dropdown)
With Rows(doelRij + 1).Cells(1, 1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Bezoek"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With

' Toon een berichtvenster met het rijnummer
MsgBox "Rij toegevoegd onder rijnummer: " & doelRij
Else
' Toon een foutbericht als de ingevoerde waarde niet geldig is
MsgBox "Ongeldige invoer. Voer een geldig rijnummer in.", vbExclamation
End If
End Sub

 

[snb]

VBA kopieert, wordt ingevoegd, wordt meegenomen, kopieert hij

 

[joh88]

het gekke is dat hij wel de dropdown meeneemt zonder de uitbreiding van 2 dagen eerder, ik heb al gebrobeerd om het celbereik in te voegen of de opties bij xlBetween, Formula1:="Bezoek" maar dat werkt ook niet

 

[OctaFish]

Ik denk niet dat iemand staat te popelen om het na te bouwen. Lijkt mij een schone taak voor jou om een bestandje met de geschetste situatie mee te posten. Geheid dat je dan nog bruikbare antwoorden gaat krijgen ook. En CODE zet je altijd tussen CODE tags!

 

[snb]

Gebruik een dynamische tabel en de code is meteen overbodig.

 

[joh88]

inmiddels heb ik het opgelost! bedankt allemaal voor het meedenken

 

[Haije]

inmiddels heb ik het opgelost! bedankt allemaal voor het meedenken

Hoe?

 

[joh88]

Hoe?

Private Sub CommandButton1_Click()
    ' Ophalen van het actieve werkblad
    Dim actiefBlad As Worksheet
    Set actiefBlad = ActiveSheet

    ' Onthoud of het blad beveiligd was voordat we begonnen
    Dim wasBeveiligd As Boolean
    wasBeveiligd = actiefBlad.ProtectContents

    ' Beveiliging opheffen als het blad is beveiligd
    If wasBeveiligd Then
        Dim wachtwoord As String
        wachtwoord = "JouwWachtwoord" ' Vervang "JouwWachtwoord" door het daadwerkelijke wachtwoord van je blad
        actiefBlad.Unprotect Password:=wachtwoord
    End If

    ' Vraag de gebruiker om het rijnummer waar de nieuwe rij moet worden ingevoegd
    Dim doelRij As Variant
    doelRij = InputBox("Voer het rijnummer in waaronder de nieuwe activiteit moet worden ingevoegd:", "Rijnummer")
    
    ' Controleer of de gebruiker annuleert (lege invoer of op Annuleren klikken)
    If doelRij = "" Then
        MsgBox "Geannuleerd. Geen rijnummer ingevoerd.", vbInformation
        ' Opnieuw beveiligen van het blad als het was beveiligd
        If wasBeveiligd Then
            actiefBlad.Protect Password:=wachtwoord
        End If
        Exit Sub
    End If

 

[Haije]

Dank voor de terugkoppeling