Transfert de données conditionné

Question

Je dois transférer les données d'un tableau "source" vers un tableau "cible" en respectant les correspondances de colonnes suivantes : source vers cible A vers A B vers B C vers M D vers AA E vers AD F vers AG G vers AJ Jusque là , cela doit vous sembler simple (déja pas pour moi). Cependant, ce transfert doit se faire en fonction de la colonne A (colonne clé) : * Si une valeur située en Asource existe à l'identique en Acible, alors il s'agit d'une mise à jour , donc le transfert des données doit se faire selon le schéma sur cette même ligne. * Si la valeur située en Asource n'existe pas en Acible, alors il s'agit d'une nouvelle ligne à créer dans le tableau source, donc création d'une nouvelle ligne dans cible et transfert des données toujours selon le même schéma. Pour être plus concret : * Le tableau source comporte 8000 lignes avec des noms d'articles en A et des prix sur les autres colonnes. * Le tableu cible comporte 5000 lignes avec des noms d'articles en A et plein d'autres infos, c'est un"master" (tableau général). Le but de l'opération est donc de "rafraichir" la cible en fonction de la source ( mise à jour de prix pour les articles déja existants et ajout d'articles pour les autres). J'ai essayé d'être le plus clair possible mais ce n'est pas évident donc je suis disposé à apporter des éclaircicements sur demande Merci beaucoup d'avance PS/ j'edite ce post pour ajouter 2 fichiers exemple : https://www.excel-pratique.com/~files/doc/Svtu5source.xls https://www.excel-pratique.com/~files/doc/cible.xls...

soft · Answer

Voilà le code VBA que j'écrirais sans avoir tester faute de fichier :

Option Explicit

Const FeuilleSource = "Feuil1"
Const FeuilleDestination = "Feuil2"

Sub MiseAJour()
    Dim LigneSource As Long, LigneDestination As Long
    LigneSource = 1
    While Sheeets(FeuilleSource).Range("A" & LigneSource).Value <> ""
        LigneDestination = Destination(Sheeets(FeuilleSource).Range("A" & LigneSource).Value)

        Sheeets(FeuilleDestination).Range("A" & LigneDestination).Value = Sheeets(FeuilleSource).Range("A" & LigneSource).Value
        Sheeets(FeuilleDestination).Range("B" & LigneDestination).Value = Sheeets(FeuilleSource).Range("B" & LigneSource).Value
        Sheeets(FeuilleDestination).Range("C" & LigneDestination).Value = Sheeets(FeuilleSource).Range("M" & LigneSource).Value
        Sheeets(FeuilleDestination).Range("D" & LigneDestination).Value = Sheeets(FeuilleSource).Range("AA" & LigneSource).Value
        Sheeets(FeuilleDestination).Range("E" & LigneDestination).Value = Sheeets(FeuilleSource).Range("AD" & LigneSource).Value
        Sheeets(FeuilleDestination).Range("F" & LigneDestination).Value = Sheeets(FeuilleSource).Range("AG" & LigneSource).Value
        Sheeets(FeuilleDestination).Range("G" & LigneDestination).Value = Sheeets(FeuilleSource).Range("AJ" & LigneSource).Value

        LigneSource = LigneSource + 1
    Wend

End Sub

Function Destination(StrCherche As String) As Long
    Dim Ligne As Long
    Ligne = 1
    While Sheeets(FeuilleDestination).Range("A" & Ligne).Value <> ""
        If Sheeets(FeuilleDestination).Range("A" & Ligne).Value = StrCherche Then
            Destination = Ligne
            Exit Function
        End If
        Ligne = Ligne + 1
    Wend
    If Destination = 0 Then Destination = Ligne
End Function

Si les 2 tableaux sont 2 onglets du même fichier, il suffit de changer le nom des feuilles au début du code

2question-sandrine27.xlsx (14.26 Ko)

felix · Answer

Le code : Sub mise_a_jour() For Each cel In Range("A2:A" &amp; &#91;A65000&#93;.End(xlUp).Row) With Sheets("cible") Set c = .Columns("A:A").Find(cel, , xlValues) If Not c Is Nothing Then .Range(.Cells(c.Row, 1), .Cells(c.Row, 2)).Value = Range(Cells(cel.Row, 1), Cells(cel.Row, 2)).Value .Cells(c.Row, 13).Value = Cells(cel.Row, 3).Value .Cells(c.Row, 27).Value = Cells(cel.Row, 4).Value .Cells(c.Row, 30).Value = Cells(cel.Row, 5).Value .Cells(c.Row, 33).Value = Cells(cel.Row, 6).Value .Cells(c.Row, 36).Value = Cells(cel.Row, 7).Value Else derlig = .&#91;A65000&#93;.End(xlUp).Row + 1 .Range(.Cells(derlig, 1), .Cells(derlig, 2)).Value = Range(Cells(cel.Row, 1), Cells(cel.Row, 2)).Value .Cells(derlig, 13).Value = Cells(cel.Row, 3).Value .Cells(derlig, 27).Value = Cells(cel.Row, 4).Value .Cells(derlig, 30).Value = Cells(cel.Row, 5).Value .Cells(derlig, 33).Value = Cells(cel.Row, 6).Value .Cells(derlig, 36).Value = Cells(cel.Row, 7).Value End If End With Next cel End Sub https://www.excel-pratique.com/~files/doc/gligli92.zip...