Comment synchroniser les listes déroulantes dans plusieurs feuilles de calcul dans Excel ?

Supposons que vous ayez des listes déroulantes sur plusieurs feuilles de calcul dans un classeur qui contiennent exactement les mêmes éléments déroulants. Vous souhaitez maintenant synchroniser les listes déroulantes entre les feuilles de calcul afin qu'une fois que vous avez sélectionné un élément dans une liste déroulante d'une feuille de calcul, les listes déroulantes des autres feuilles de calcul soient automatiquement synchronisées avec la même sélection. Cet article fournit un code VBA pour vous aider à résoudre ce problème.

Synchroniser les listes déroulantes dans plusieurs feuilles de calcul avec le code VBA

Synchroniser les listes déroulantes dans plusieurs feuilles de calcul avec le code VBA

Par exemple, les listes déroulantes se trouvent dans cinq feuilles de calcul nommées Feuil1, Feuil2, ..., Feuille5, pour synchroniser les listes déroulantes dans d'autres feuilles de calcul en fonction de la sélection déroulante dans Sheet1, veuillez appliquer le code VBA suivant pour le faire.

1. Ouvrez Sheet1, cliquez avec le bouton droit sur l'onglet de la feuille et sélectionnez Voir le code dans le menu contextuel.

2. dans le Microsoft Visual Basic pour applications fenêtre, collez le code VBA suivant dans la Feuil1 (Code) fenêtre.

Code VBA : liste déroulante Synchroniser dans plusieurs feuilles de calcul

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

Notes:

1) Dans le code, A2: A11 est la plage contenant la liste déroulante. Assurez-vous que toutes les listes déroulantes se trouvent dans la même plage sur différentes feuilles de calcul.

2) Feuil2, Feuil3, Feuil4 et Sheet5 sont des feuilles de calcul contenant des listes déroulantes que vous souhaitez synchroniser en fonction de la liste déroulante dans Feuil1 ;

3) Pour ajouter plus de feuilles de calcul dans le code, veuillez ajouter les deux lignes suivantes avant la ligne "Application.EnableEvents = True", puis changez le nom de la feuille "Sheet5” au nom dont vous avez besoin.

Définir tSheet1 = ActiveWorkbook.Worksheets("Sheet5")

tSheet1.Range(xRangeStr).Value = Target.Value

3. appuie sur le autre + Q touches pour fermer le Microsoft Visual Basic pour applications fenêtre.

Désormais, lorsque vous sélectionnez un élément dans la liste déroulante de Feuille1, les listes déroulantes dans les feuilles de calcul spécifiées seront synchronisées automatiquement pour avoir la même sélection. Voir la démo ci-dessous.

Démo : Synchroniser les listes déroulantes dans plusieurs feuilles de calcul dans Excel

Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2021 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Fonctionnalités complètes Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.

Lire la suite... Téléchargement Gratuit... Achat...

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!

Lire la suite... Téléchargement Gratuit... Achat...

Commentaires (5)

Pas encore de notes. Soyez le premier à évaluer!

mois environ, il ya 3

#40764

Ce commentaire a été minimisé par le modérateur sur le site

Bonjour,

Comment puis-je faire cela si mes listes déroulantes sont dans des plages différentes ? Pour élaborer, j'ai une liste déroulante dans la feuille 7 qui se trouve dans la cellule B7 et la même liste déroulante sur la feuille 6 dans la cellule B2.

Je vous remercie,
Elaine

Répondre

cristal E

mois environ, il ya 3

#40859

Ce commentaire a été minimisé par le modérateur sur le site

Salut E,
Le code VBA suivant peut vous aider.
Ici, je prends Sheet6 comme feuille de calcul principale, cliquez avec le bouton droit sur l'onglet de la feuille, sélectionnez Afficher le code dans le menu contextuel, puis copiez le code suivant dans la fenêtre Sheet6 (Code). Lorsque vous sélectionnez un élément dans la liste déroulante en B2 de Sheet6, la liste déroulante en B7 de Sheet7 sera cynchronisée pour avoir le même élément sélectionné.

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

Répondre

Rapport

E cristal

mois environ, il ya 3

#40915

Ce commentaire a été minimisé par le modérateur sur le site

Salut Crystal,

Merci beaucoup pour votre réponse, votre code a fonctionné ! J'ai une cellule juste sous b2 et b7, b3 et b8 respectivement qui doivent avoir la même fonction. J'ai essayé de réécrire votre code comme indiqué ci-dessous, mais cela n'a pas fonctionné. Cela a fait changer b7 au lieu de b8 lorsque j'ai changé b3. Pourriez-vous être en mesure d'identifier ce que je fais mal?

Merci beaucoup!

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

Répondre

cristal E

mois environ, il ya 3

#40991

Ce commentaire a été minimisé par le modérateur sur le site

Salut E,
Il y a quelque chose qui ne va pas avec le code VBA auquel je vous ai répondu ci-dessus.
Pour la nouvelle question que vous avez mentionnée, veuillez essayer le code suivant.

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

Répondre

Rapport

mois environ, il ya 3

#40890

Ce commentaire a été minimisé par le modérateur sur le site

Cristal,

Merci beaucoup pour votre réponse, cela a fonctionné! Comment pourrais-je modifier le code pour ajouter une autre cellule dans la même feuille 6, B3 qui devait également être synchronisée avec B8 dans la feuille 7 ? J'ai tenté de le modifier ci-dessous, mais il finit par mettre le contenu de B3 sur la feuille 6 en B7 sur la feuille 7 au lieu de B8.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
'Mis à jour par Extendoffice 20221025
Dim tSheet1 en tant que feuille de travail
Dim tRange1 As Range
Dim tRange2 As Range
Dim xRangeStr1 As String
Dim xRangeStr2 As String
On Error Resume Next
Si Target.Count> 1, puis quitter le sous-marin

xRangeStr1 = "B2"
xRangeStr2 = "B3"

Définir tRange1 = Range("B7")
Si non tRange1 n'est rien alors
xRangeStr1 = tRange1.Address
Application.EnableEvents = False
Définir tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr1).Value = Target.Value
Application.EnableEvents = True
Si fin

Définir tRange2 = Range("B8")
Si non tRange2 n'est rien alors
xRangeStr2 = tRange2.Address
Application.EnableEvents = False
Définir tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr2).Value = Target.Value
Application.EnableEvents = True
Si fin

End Sub

Répondre

Il n'y a pas encore de commentaires postés ici

Laisser vos commentaires

Publier en tant qu'invité

Espace client

Nom (Obligatoire)

Email (Obligatoire)

Évaluez cet article:

Réinitialiser

0 Personnages

J'accepte les termes et conditions