Hoe vervolgkeuzelijsten in meerdere werkbladen in Excel te synchroniseren?

Stel dat u vervolgkeuzelijsten op verschillende werkbladen in een werkmap hebt die precies dezelfde vervolgkeuzelijsten bevatten. Nu wilt u de vervolgkeuzelijsten synchroniseren tussen werkbladen, zodat zodra u een item uit een vervolgkeuzelijst in één werkblad selecteert, de vervolgkeuzelijsten in andere werkbladen automatisch dezelfde selectie worden gesynchroniseerd. Dit artikel biedt een VBA-code om u te helpen dit probleem op te lossen.

Synchroniseer vervolgkeuzelijsten in meerdere werkbladen met VBA-code

Synchroniseer vervolgkeuzelijsten in meerdere werkbladen met VBA-code

De vervolgkeuzelijsten zijn bijvoorbeeld in vijf werkbladen met de naam Blad1, Blad2, ..., Blad5, om de vervolgkeuzelijsten in andere werkbladen te synchroniseren volgens de vervolgkeuzelijst in Blad1, pas de volgende VBA-code toe om het voor elkaar te krijgen.

1. Open Blad1, klik met de rechtermuisknop op de bladtab en selecteer Bekijk code in het snelmenu.

2. In de Microsoft Visual Basic voor toepassingen venster, plak de volgende VBA-code in de Blad1 (Code) venster.

VBA-code: vervolgkeuzelijst synchroniseren in meerdere werkbladen

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220815
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "A2:A11"

    Set tRange = Intersect(Target, Range(xRangeStr))
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet2")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet3")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet4")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub

Opmerkingen:

1) In de code, A2: A11 is het bereik dat de vervolgkeuzelijst bevat. Zorg ervoor dat alle vervolgkeuzelijsten zich in hetzelfde bereik op verschillende werkbladen bevinden.

2) Blad2, Blad3, Blad4 en Sheet5 zijn werkbladen met vervolgkeuzelijsten die u wilt synchroniseren op basis van de vervolgkeuzelijst in Blad1;

3) Als u meer werkbladen aan de code wilt toevoegen, voegt u de volgende twee regels toe vóór de regel "Application.EnableEvents = Waar”, verander dan de bladnaam “Sheet5” naar de naam die u nodig hebt.

Stel tBlad1 = ActiveWorkbook.Worksheets ("Blad5") in

tBlad1.Bereik(xBereikStr).Waarde = Doel.Waarde

3. druk de anders + Q toetsen om de Microsoft Visual Basic voor toepassingen venster.

Vanaf nu, wanneer u een item selecteert in de vervolgkeuzelijst in Blad1, de vervolgkeuzelijsten in de opgegeven werkbladen worden automatisch gesynchroniseerd om dezelfde selectie te hebben. Zie onderstaande demo.

Demo: synchroniseer vervolgkeuzelijsten in meerdere werkbladen in Excel

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2021 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functies Gratis proefperiode van 30 dagen. 60 dagen geld-terug-garantie.

Lees verder... Gratis download... Aankoop...

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!

Lees verder... Gratis download... Aankoop...

Heb je vragen? Stel ze hier. (5)

Nog geen beoordelingen. Beoordeel als eerste!

ongeveer 3 maanden geleden

#40764

Deze opmerking is gemaakt door de moderator op de site

Hoi,

Hoe kan ik dit doen als mijn vervolgkeuzelijsten zich in verschillende bereiken bevinden? Om uit te werken, heb ik een vervolgkeuzelijst in blad 7 in cel B7 en dezelfde vervolgkeuzelijst op blad 6 in cel B2.

Dank je,
Elaine

Antwoorden

crystal E

ongeveer 3 maanden geleden

#40859

Deze opmerking is gemaakt door de moderator op de site

Hallo E,
De volgende VBA-code kan helpen.
Hier neem ik Sheet6 als het hoofdwerkblad, klik met de rechtermuisknop op de bladtab, selecteer Code weergeven in het rechtsklikmenu en kopieer vervolgens de volgende code in het venster Sheet6 (Code). Wanneer u een item selecteert in de vervolgkeuzelijst in B2 van Blad6, wordt de vervolgkeuzelijst in B7 van Blad7 gecynchroniseerd om hetzelfde geselecteerde item te hebben.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "B2"
    
    Set tRange = Range("B7")
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub

Antwoorden

Rapport

E crystal

ongeveer 3 maanden geleden

#40915

Deze opmerking is gemaakt door de moderator op de site

Hallo Kristal,

Heel erg bedankt voor je reactie, je code werkte! Ik heb een cel recht onder respectievelijk b2 en b7, b3 en b8 die dezelfde functie moeten hebben. Ik heb geprobeerd je code te herschrijven zoals hieronder weergegeven, maar dit is niet gelukt. Het zorgde ervoor dat b7 in plaats van b8 veranderde toen ik b3 veranderde. Kunnen jullie misschien achterhalen wat ik fout doe?

Heel erg bedankt!

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange1 As Range
    Dime tRange2 As Range
    Dim xRangeStr1 As String
    Dim xRangeStr2 As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr1 = "B2"
    xRangeStr2="B3"
    
    Set tRange1 = Range("B7")
    If Not tRange1 Is Nothing Then
        xRangeStr1 = tRange1.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr1).Value = Target.Value
        Application.EnableEvents = True
    End If
    
    Set tRange2 = Range("B8")
    If Not tRange2 Is Nothing Then
        xRangeStr2 = tRange2.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr2).Value = Target.Value
        Application.EnableEvents = True
    End If

End Sub

Antwoorden

crystal E

ongeveer 3 maanden geleden

#40991

Deze opmerking is gemaakt door de moderator op de site

Hallo E,
Er is iets mis met de VBA-code die ik hierboven heb beantwoord.
Probeer de volgende code voor de nieuwe vraag die u noemde.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221031
    
    Dim xBool1 As Boolean
    Dim xBool2 As Boolean
    Dim xRgStr As String
    Dim tRange As Range
    
    xRangeStr1 = "B2"
    xRangeStr2 = "B3"
    xRgStr = ""
    
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    xBool1 = Intersect(Target, Range(xRangeStr1)) Is Nothing
    xBool2 = Intersect(Target, Range(xRangeStr2)) Is Nothing
    
    If xBool1 And xBool2 Then Exit Sub
    
    xRgStr = Target.Address(False, False, xlA1, False, False)
    
    If Target.Address(False, False, xlA1, False, False) = xRangeStr1 Then
        xRgStr = "b7"
    ElseIf Target.Address(False, False, xlA1, False, False) = xRangeStr2 Then
        xRgStr = "b8"
    End If
    If xRgStr = "" Then Exit Sub
    
    Application.EnableEvents = False
    Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
    tSheet1.Range(xRgStr).Value = Target.Value
    Application.EnableEvents = True

End Sub

Antwoorden

Rapport

ongeveer 3 maanden geleden

#40890

Deze opmerking is gemaakt door de moderator op de site

Kristal,

Heel erg bedankt voor je reactie, dit is gelukt! Hoe kon ik de code wijzigen om nog een cel toe te voegen in hetzelfde blad 6, B3, die ook moest worden gesynchroniseerd met B8 in blad 7? Ik heb geprobeerd het hieronder aan te passen, maar uiteindelijk wordt de inhoud van B3 op blad 6 in B7 op blad 7 geplaatst in plaats van B8.

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'Bijgewerkt door' Extendoffice 20221025
Dim tSheet1 als werkblad
Dim tRange1 Als bereik
Dim tRange2 Als bereik
Dim xRangeStr1 als tekenreeks
Dim xRangeStr2 als tekenreeks
On Error Resume Next
Als Target.Count > 1 Sub afsluiten

xBereikStr1 = "B2"
xBereikStr2 = "B3"

Stel tBereik1 = Bereik ("B7") in
Als niet tRange1 niets is, dan
xRangeStr1 = tRange1.Adres
Application.EnableEvents = False
Stel tBlad1 = ActiveWorkbook.Worksheets ("Blad7") in
tBlad1.Bereik(xBereikStr1).Waarde = Doel.Waarde
Application.EnableEvents = Waar
End If

Stel tBereik2 = Bereik ("B8") in
Als niet tRange2 niets is, dan
xRangeStr2 = tRange2.Adres
Application.EnableEvents = False
Stel tBlad1 = ActiveWorkbook.Worksheets ("Blad7") in
tBlad1.Bereik(xBereikStr2).Waarde = Doel.Waarde
Application.EnableEvents = Waar
End If

End Sub

Antwoorden

Er zijn nog geen reacties geplaatst

Laat uw commentaar

Posten als gast

Inloggen

Naam (verplicht)

E-mail (Verplicht)

Beoordeel dit bericht:

Reset

0 Personages

Ik ga akkoord met de bepalingen en voorwaarden