XL 2010 copie valeur de données d'une feuille dans une autre vba

djiska · 4 Février 2020

Bonjour ,

j'aimerai pouvoir copier les informations d'une liste plus ancienne ,par les infos plus récentes par VBA.
ancienne 2019. (année de de référence)
nouvelle 2020
feuille à compléter (mise à jour)
si pour un numéro quelconque de 2019 les informations ne sont pas disponibles dans la feuille 2020
alors on laisse le(s) champ(s) à compléter vide.

je le fais avec recherche v mais c pas évident .
alors j'ai pensé à un code VBA, si quelqu'un pourrait m'aider .

voir fichier joint
merci

vgendron · 5 Février 2020

Hello
Pour que ca fonctionne.. il faut juste que tu corriges le nom de ta feuille "Mise à jour" en enlevant l'espace de fin
je l'avais fait, mais oublié de te le préciser

je te remet le code ici avec des commentaires explicatifs

VB:

Sub Update()
Dim tab2019() As Variant
Dim tab2020() As Variant
Dim tabMaJ() As Variant
Set dico2019 = CreateObject("scripting.dictionary")
Set dico2020 = CreateObject("scripting.dictionary")
Set dicoMaj = CreateObject("scripting.dictionary")


With Sheets("2019") 'dans la feuille "2019"
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'on récupère le numéro de la dernière ligne du tableau
    tab2019 = .Range("A3:G" & fin).Value ' on met tout dans un tablo
    For i = LBound(tab2019, 1) To UBound(tab2019...

danielco · 4 Février 2020

Bonjour,

En C3, à recopier vers la droite et le bas :

VB:

=SIERREUR(INDEX('2020'!C$3:C$369;EQUIV('Mise à jour '!$A3;'2020'!$A$3:$A$369;0));INDEX('2019'!C$3:C$369;EQUIV('Mise à jour '!$A3;'2019'!$A$3:$A$369;0)))

Cordialement.

Daniel

vgendron · 4 Février 2020

Bonjour un essaie avec ce code à placer dans un module standard

VB:

Sub Update()
Dim tab2019() As Variant
Dim tab2020() As Variant
Dim tabMaJ() As Variant
Set dico2019 = CreateObject("scripting.dictionary")
Set dico2020 = CreateObject("scripting.dictionary")
Set dicoMaj = CreateObject("scripting.dictionary")


With Sheets("2019")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tab2019 = .Range("A3:G" & fin).Value
    For i = LBound(tab2019, 1) To UBound(tab2019, 1)
        If Not dico2019.exists(tab2019(i, 1)) Then dico2019.Add tab2019(i, 1), i
    Next i
End With
With Sheets("2020")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tab2020 = .Range("A3:G" & fin).Value
    For i = LBound(tab2020, 1) To UBound(tab2020, 1)
        If Not dico2020.exists(tab2020(i, 1)) Then dico2020.Add tab2020(i, 1), i
    Next i
End With

With Sheets("Mise à jour")

    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("C3:G" & fin).ClearContents
    tabMaJ = .Range("A3:G" & fin).Value
    For i = LBound(tabMaJ, 1) To UBound(tabMaJ, 1)
        If Not dicoMaj.exists(tabMaJ(i, 1)) Then dicoMaj.Add tabMaJ(i, 1), i
    Next i
End With

For i = LBound(tabMaJ, 1) To UBound(tabMaJ, 1)
    If dico2019.exists(tabMaJ(i, 1)) Then
        If dico2020.exists(tabMaJ(i, 1)) Then
            For j = 3 To UBound(tabMaJ, 2)
                tabMaJ(i, j) = tab2020(dico2020(tabMaJ(i, 1)), j)
            Next j
        Else
            
            For j = 3 To UBound(tabMaJ, 2)
                tabMaJ(i, j) = ""
            Next j
        End If
    End If
Next i
With Sheets("Mise à jour")
    .Range("A3").Resize(UBound(tabMaJ, 1), UBound(tabMaJ, 2)) = tabMaJ
End With


End Sub

djiska · 4 Février 2020

Merci à vous deux

Vgendron , j'ai copié le code malheureusement cela ne fonctionne pas .

GALOUGALOU · 4 Février 2020

bonjour djiska
question
que faut-il renvoyer comme informations dans la feuille mise à jour
les infos 2020 et si celle ci sont absente les infos 2019 ?
cordialement
galougalou

djiska · 4 Février 2020

finalement, je simplifie.

je veux remplacer chaque les valeurs (initiales, facturées, achetee, ajustee et finale) de la feuille 2019 par celle de 2020.

La feuille mise à jour servait à faire une recherche du genre (recherve V) mais ca n'avait pas marché.
donc faut juste un code qui copie les valeurs de 2020 dans la feuillle 2019 (selon le code du produit)

si un numéro 2019 ne figure pas sur la liste 2020 alors laisser les cases((initiales, facturées, achetee, ajustee et finale) correspondantes vides.

merci

vgendron · 5 Février 2020

Hello
Pour que ca fonctionne.. il faut juste que tu corriges le nom de ta feuille "Mise à jour" en enlevant l'espace de fin
je l'avais fait, mais oublié de te le préciser

je te remet le code ici avec des commentaires explicatifs

VB:

Sub Update()
Dim tab2019() As Variant
Dim tab2020() As Variant
Dim tabMaJ() As Variant
Set dico2019 = CreateObject("scripting.dictionary")
Set dico2020 = CreateObject("scripting.dictionary")
Set dicoMaj = CreateObject("scripting.dictionary")


With Sheets("2019") 'dans la feuille "2019"
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'on récupère le numéro de la dernière ligne du tableau
    tab2019 = .Range("A3:G" & fin).Value ' on met tout dans un tablo
    For i = LBound(tab2019, 1) To UBound(tab2019, 1) 'pour chaque ligne du tablo
        If Not dico2019.exists(tab2019(i, 1)) Then dico2019.Add tab2019(i, 1), i 'on ajoute le numéro dans un dictionnaire
    Next i
End With

With Sheets("2020") 'idem 2019
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tab2020 = .Range("A3:G" & fin).Value
    For i = LBound(tab2020, 1) To UBound(tab2020, 1)
        If Not dico2020.exists(tab2020(i, 1)) Then dico2020.Add tab2020(i, 1), i
    Next i
End With

With Sheets("Mise à jour") 'idem 2019

    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("C3:G" & fin).ClearContents
    tabMaJ = .Range("A3:G" & fin).Value
    For i = LBound(tabMaJ, 1) To UBound(tabMaJ, 1)
        If Not dicoMaj.exists(tabMaJ(i, 1)) Then dicoMaj.Add tabMaJ(i, 1), i
    Next i
End With

For i = LBound(tabMaJ, 1) To UBound(tabMaJ, 1) 'pour chaque ligne du tablo Maj
    If dico2019.exists(tabMaJ(i, 1)) Then 'si le numéro existait en 2019
        If dico2020.exists(tabMaJ(i, 1)) Then 'si il existe aussi en 2020
            For j = 3 To UBound(tabMaJ, 2) 'on met les valeurs de 2020 dans tabMag
                tabMaJ(i, j) = tab2020(dico2020(tabMaJ(i, 1)), j)
            Next j
        Else 'sinon (existe en 2019 mais PAS en 2020
            
            For j = 3 To UBound(tabMaJ, 2) 'on vide la ligne
                tabMaJ(i, j) = ""
            Next j
        End If
    End If
Next i

With Sheets("Mise à jour") 'on colle le tablo maj dans la feuille Mise à jour
    .Range("A3").Resize(UBound(tabMaJ, 1), UBound(tabMaJ, 2)) = tabMaJ
End With


End Sub

djiska · 5 Février 2020

Bonjour Vgendron,

je ne sais pas si tu as fais l'essai mais de mon coté rien ne se passe !!!

Merci,

vgendron · 5 Février 2020

bien sur que j'ai fait l'essai...
il faut quand meme cliquer sur le bouton "executer la macro".....
ou créer un bouton sur ta feuille et lui affecter la macro..

djiska · 5 Février 2020

j'avais déjà cliquer sur executer la Macro
là je viens de créer un bouton et affecter la macro(thisworkbook.update) mais toujours rien..
si tu l'as essayé et que ca marché alors c pas mon jour de chance ….

vgendron · 5 Février 2020

la chance n'a rien à voir la dedans..
1) as tu noté que la macro fait ce qui était demandé à l'origine.. à savoir.. elle met à jour la feuille "Mise à jour"

2) les premières lignes de la feuille "Mise à jour" concerne des numéros qui n'existent pas dans la feuille 2020 ===> Elles sont donc vidées
3) pour "voir" quelque chose, il faut que tu descendes au moins à la ligne 46
j'ai ajouté un message de fin de macro

djiska · 5 Février 2020

Tu as raison, effectivement je n'ai pas eu la présence d'esprit de descendre plus bas.
la Macro fonctionne bien .

Merci de ta disponibilité

XL 2010 copie valeur de données d'une feuille dans une autre vba

djiska

XLDnaute Junior

Pièces jointes

vgendron

danielco

XLDnaute Accro

vgendron

XLDnaute Barbatruc

djiska

XLDnaute Junior

GALOUGALOU

XLDnaute Accro

djiska

XLDnaute Junior

vgendron

XLDnaute Barbatruc

djiska

XLDnaute Junior

vgendron

XLDnaute Barbatruc

djiska

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Pièces jointes

djiska

XLDnaute Junior

Discussions similaires