récupération de données (adaptation code mondico)

cathodique

XLDnaute Barbatruc
bonjour la communauté,

ce code est de Robert qui je salue et remercie car ça m'a permis d'avancer dans mon apprentissage, j'avais omis de préciser que je voulais récupérer des données de plusieurs colonnes. je voudrai donc modifier ce code qui fonctionne très bien dans mon cas.
Code:
Sub Macro_Robert2()
Dim bd As Object 'déclare la variable bd (onglet BD)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim dics As Object 'déclare la variable dics (DICtionnaireS)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim teo As Variant 'déclare le tableau de variables teo (tableau TEmporaire Outils)
Dim x As Integer 'déclare la variable x
Dim y As Integer 'déclare la variable y

Set bd = Sheets("BD") '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 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet bd
Set pl = bd.Range("B2: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
    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, 1).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
    teo = dics.keys 'définit le tabeau teo
    y = 0 'initialise la variable y
    For x = 0 To UBound(teo) 'boucle 3 : sur toutes les outils (sans doublon)
        o.Cells(1, y + 2).Value = teo(x) 'place l'outil dans le tableau
        y = y + 2 'incrément y
    Next x 'prochain outil de la boucle 3
    For Each cel In pl.Offset(0, 2).SpecialCells(xlCellTypeVisible) 'boucle 4 : sur toutes les cellules visibles cel de la plage pl déclalée de deux colonnes à droite
        Set dest = IIf(o.Range("A2").Value = "", o.Range("A2"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination
        dest.Value = cel.Value 'récupère dans dest la valeur de la cellule cel
    Next cel 'prochaine cellule de la boucle 4
    bd.Range("A1").AutoFilter 'annule le filtre automatique
Next i 'prochaine valeur de la boucle 1
End Sub

ci-dessus le code complet, je voudrai trouver la solution pour récupérer les données de 2 colonnes suivantes à la colonne A, le bout de code à modifier est ci-dessous du moins si je ne me trompe pas car débutant en VBA

Code:
For Each cel In pl.Offset(0, 2).SpecialCells(xlCellTypeVisible) 'boucle 4 : sur toutes les cellules visibles cel de la plage pl déclalée de deux colonnes à droite
        Set dest = IIf(o.Range("A2").Value = "", o.Range("A2"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination
        dest.Value = cel.Value 'récupère dans dest la valeur de la cellule cel
    Next cel 'prochaine cellule de la boucle 4

ne récupére que les données de la colonne D de la feuille "BD", souhaite récupérer données colonnes E et F.
En vous remerciant par avance.
 

Discussions similaires

Statistiques des forums

Discussions
312 239
Messages
2 086 508
Membres
103 236
dernier inscrit
Menni