Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Appliquer du code VBA à l'ensemble des feuilles de mon classeur

Looper

XLDnaute Nouveau
Bonjour,
Pas très au point en VBA, je sollicite votre aide pour résoudre mon problème.
J'ai un classeur que comporte 56 feuilles identiques (se sont de feuilles de service pour gérer jour par jour un pool de personnes)
Sur ma première feuille, j'ai une combobox avec un liste déroulante qui me permet de choisir intuitivement des noms. Ça fonctionne parfaitement sur ma première feuille.
Par contre je n'ai pas envie de faire un copier/coller de ce code sur chaque feuilles!

Existe-il un moyen d'appliquer à l'ensemble des feuilles du classeur ?

Merci d'avance pour votre aide

VB:
Dim a()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([c11:c13, c21, c40:c48, c50, d9, d15:d16, d18:d19, d23, d25, d29, d31,d32, d34,d35, d37, d40:d50, e11:e13, e21, e40:e50], Target) Is Nothing And Target.Count = 1 Then
    a = Sheets("Equipes").Range("Liste_nom").Value
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = False
    Me.ComboBox1.Activate
    Me.ComboBox1.DropDown
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub

Private Sub ComboBox1_Change()
  If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
    Set d1 = CreateObject("Scripting.Dictionary")
    'tmp = "*" & UCase(Me.ComboBox1) & "*"
    tmp = UCase(Me.ComboBox1) & "*"
    For Each c In a
      If UCase(c) Like tmp Then d1(c) = ""
    Next c
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = a
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then ActiveCell.Offset(1).Select
End Sub
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…