XL 2016 transfert de donnée avec id unique

  • Initiateur de la discussion Initiateur de la discussion Jauster
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Jauster

XLDnaute Occasionnel
Bonjour le forum,

La macro suivante permet de faire un copier de plusieurs colonnes (I:N) de ma feuille Mono2 a ma feuille Mono, tout en prenant en compte un identifiant unique en colonne D (j'utilise un Dico et non une formule recherchev à cause de la taille du fichier, mais le résultat est le même).Les deux feuilles sont identiques dans la forme (mêmes colonnes, mêmes informations...). Uniquement le nombre de ligne peut changer.

Je souhaite changer cette formule pour l'adapter à un autre cas (Bom2 et Bom) :
Cette fois l'identifiant unique se trouve à droite des informations que je souhaite copier/coller (NB : Ils étaient à gauche pour le cas precedent), et je n'arrive pas à changer le code pour le faire fonctionner (j'ai encore un peu de mal avec Dico/Tablo).

Si joint un fichier pour vous donner une idée de la mise en page et du problème
>> pblm.xlsx <<

Merci,

VB:
Sub ModifManu()
Dim fin As Integer, FinMono As Integer
Dim MonDico

Set MonDico = CreateObject("scripting.dictionary")
Dim Tablo2() As Variant
Dim Tablo() As Variant

With Worksheets("Mono2")
    fin = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo2 = .Range("D3:N" & fin).Value
End With
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    valeur = ""
    For j = 6 To 11
        valeur = valeur & "-" & Tablo2(i, j)
    Next j
    MonDico.Add Tablo2(i, 1), valeur
Next i

With Worksheets("Mono")
    FinMono = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo = .Range("D3:N" & FinMono).Value
    On Error Resume Next
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        For j = 6 To 11
            Tablo(i, j) = Split(MonDico(Tablo(i, 1)), "-")(j - 5)
        Next j
    Next i
    .Range("D3:N" & FinMono) = Tablo
End With

Set MonDico = Nothing

End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
177
Réponses
10
Affichages
281
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
649
Réponses
3
Affichages
193
Réponses
3
Affichages
665
Réponses
5
Affichages
477
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
10
Affichages
799
Retour