Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

djiska

XLDnaute Junior
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
 

Pièces jointes

  • inventaire macro.xlsx
    195.6 KB · Affichages: 5
Solution
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

XLDnaute Accro
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

XLDnaute Barbatruc
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

XLDnaute Junior
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

XLDnaute Barbatruc
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
 
Dernière édition:

djiska

XLDnaute Junior
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • inventaire macro.xlsm
    204.9 KB · Affichages: 28

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…