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
Partager