Bonsoir,

dans une feuille, j'ai plusieurs tableaux structurés (listobject).
Dans une autre feuille, je souhaite, par macro, charger des listes de validation depuis les tableaux structurés.
Ci-dessous mon code de module, suivi par la procédure qui doit s'occuper de charger les listes de validation.
Je voudrais éviter d'utiliser des noms fixes de tableau, c'est pourquoi j'utilise "Listobjects(cpt1)".
Merci pour vos éclairages

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub tables_to_table()
   Dim namingOfferSheet As Worksheet, newOfferSheet As Worksheet
   Dim nbtab As Long, cpt1 As Long
   Dim offer As String, nameOfSheet As String
 
   selectSheet nameOfSheet
   Set namingOfferSheet = ActiveWorkbook.Worksheets(nameOfSheet)
   offer = namingOfferSheet.ListObjects(1).DataBodyRange(1, 1)
   addNewNamedSheet offer     'creates a new sheet with the name of the offer
   Set newOfferSheet = ActiveWorkbook.Worksheets(offer)
   nbtab = namingOfferSheet.ListObjects.Count      'counts the number of tables to "import"
   'Create a new table with the validation lists
   newOfferSheet.ListObjects.Add SourceType:=xlSrcRange, Source:=newOfferSheet.Range("B5")
   newOfferSheet.Cells(6, 2) = offer      'copy the name of the Offer "imported"
   For cpt1 = 1 To nbtab
      newOfferSheet.Cells(5, (cpt1 + 1)) = namingOfferSheet.ListObjects(cpt1).HeaderRowRange(1)
   Next cpt1
   For cpt1 = 2 To nbtab
      addListsToTable newOfferSheet, cpt1, namingOfferSheet
   Next cpt1
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub addListsToTable(newOfferSheet As Worksheet, cpt1 As Long, namingOfferSheet As Worksheet)
   With newOfferSheet.ListObjects(1).DataBodyRange(cpt1).Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=indirect(""namingOfferSheet.ListObjects(cpt1).ListColumns(1).DataBodyRange"")"    'JE COINCE ICI
      .IgnoreBlank = True
      .InCellDropdown = True
      .InputTitle = ""
      .ErrorTitle = ""
      .InputMessage = ""
      .ErrorMessage = ""
      .ShowInput = True
      .ShowError = True
   End With
End Sub