cathodique
XLDnaute Barbatruc
Bonjour la communauté,
Je sollicite votre aide. Je vous précise que mes connaissances en VBA sont des plus limités. J'ai donc récupéré, un code de Robert qui fonctionne bien. Il me permet de récupèrer des données d'une feuille source vers des feuilles de destination sans doublons (source colonne B vers Destination colonne A). Je voudrais compléter ce transfert comme ceci: source colonnes F et G vers Destination colonnes B et C. Je vous remercie d'avance. Avec les exemples de Boisgontier, j'ai bien compris la logique du code avec l'objet scripting.dictionary et suis parvenu à réaliser des formulaires avec bombobox, listbox et textbox en cascade. Par contre, là je nage vraiment.
Je vous remercie beaucoup.
Je sollicite votre aide. Je vous précise que mes connaissances en VBA sont des plus limités. J'ai donc récupéré, un code de Robert qui fonctionne bien. Il me permet de récupèrer des données d'une feuille source vers des feuilles de destination sans doublons (source colonne B vers Destination colonne A). Je voudrais compléter ce transfert comme ceci: source colonnes F et G vers Destination colonnes B et C. Je vous remercie d'avance. Avec les exemples de Boisgontier, j'ai bien compris la logique du code avec l'objet scripting.dictionary et suis parvenu à réaliser des formulaires avec bombobox, listbox et textbox en cascade. Par contre, là je nage vraiment.
Code:
Sub essai3()
Dim bd As Object '(onglet BD)
Dim dico As Object '(DICtiOnnaire)
Dim dl As Integer '(Dernière Ligne)
Dim pl As Range 'PLage)
Dim cel As Range '(CELlule)
Dim temp As Variant '(tableau TEMPoraire)
Dim i As Integer '(Incrément)
Dim dics As Object 'DICtionnaireS)
Dim o As Object '(Onglet)
Dim teo As Variant '(tableau TEmporaire Outils)
Dim x As Integer 'variable x
Dim y As Integer 'variable y
Dim dercol As Integer '(Dernière colonne)
Set bd = Sheets("Consultation") 'définit l'onglet bd
Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row 'dernière ligne éditée dl de la colonne 1 (=A) de l'onglet bd
Set pl = bd.Range("B8:B" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
dico(cel.Value) = "" 'alimente le dictionnaire dico
Next cel 'prochaine cellule de la boucle
temp = dico.keys 'récupère le dictionnaire sans doublon dans le tableau temp
For i = 0 To UBound(temp) 'boucle 1 : sur toutes les valeurs uniques du tableau temp
Set o = Sheets(temp(i)) 'définit l'onglet o
o.UsedRange.Clear 'efface les anciennes données
o.UsedRange.MergeCells = False
bd.Range("A1").AutoFilter 'lance le filtre automatique
bd.Range("A1").AutoFilter field:=2, Criteria1:=temp(i) 'filtre automatique sur la colonne 2 (=B) avec la valeur temp(i) comme critère
Set dics = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dics
For Each cel In pl.Offset(0, 2).SpecialCells(xlCellTypeVisible) 'boucle 2 : sur toutes les cellules visibles cel de la plage pl déclalée d'un colonne à droite
dics(cel.Value) = "" 'alimente le dictionnaire dics
Next cel 'prochaine cellule de la boucle 2
o.Range("A8").Resize(dics.Count) = Application.Transpose(dics.keys) 'renvoie en colonne à partir de A2 la liste des outils sans doublons
bd.Range("A1").AutoFilter 'annule le filtre automatique
Next i 'prochaine valeur de la boucle 1
End SubJe vous remercie beaucoup.
