Insérer une liste déroulante sur une macro existante
Bonjour à tous !
J'ai ouvert un sujet la semaine passée sur la division d'un tableau en différents classeurs suivant une colonne du tableau https://forum.excel-pratique.com/excel/diviser-un-tableau-en-differents-classeurs-suivant-une-colonn... - Merci à ThauThème pour son aide précieuse !
Même thème mais autre sujet : je souhaite intégrer dans le code ci-dessous un choix de listes déroulantes (les listes se trouvent dans un deuxième onglet nommé "Listes déroulantes"). Je dois pouvoir associer différentes liste sur différentes plages de mon tableau. Ce tableau, grâce à la macro ci-dessous, se divise en autant de fichiers qu'il y a de noms de fournisseurs (colonne D). Une fois le fichier divisé, chaque listes déroulantes doit se retrouver dans les fichiers divisés, sur les bonnes cellules.
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (CHemin d'Accès)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim NC As Workbook 'déclare la variable NC (Nouveau Classeur)
Dim NO As Worksheet 'déclare la variable NO (Nouvel Onglet)
Dim ListeDer As Variant
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Master") 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
D(TV(I, 4)) = "" 'alimente le dictionnaire D avec les données en colonne 4 (Nom Fournisseur)
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle sur tous les élément du tableau tenporaire TMP
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les lignes
OS.Range("A1").CurrentRegion.AutoFilter 4, TMP(J) 'fitre la colonne 4 de l'onglet OS avec TMP(J) comme critére
Set NC = Workbooks.Add 'définit le classeur NC en ajoutant un classeur vierge
Set NO = NC.Worksheets(1) 'définit l'onglet NO
OS.Range("A1").CurrentRegion.Copy NO.Range("A1") 'copy les cellules adjacentes a A1
OS.Range("A1").CurrentRegion.Copy
NO.Range("A1").PasteSpecial (xlPasteAllUsingSourceTheme) 'colle les thèmes
NO.Name = "Data_Update" 'renomme l'onglet NO
NO.Columns("A:G").AutoFit 'ajuste la largeur des colonnes
NC.SaveAs CA & NO.Range("C2").Value & "_" & TMP(J) & "_Update", 51 'enregistre sou le classeur NC
NC.Close 'ferme le classeur NC
Next J 'prochain élément de la boucle
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les lignes
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End SubQuelqu'un aurait une idée ?
Merci d'avance!
Oli.V95