Soucis sur extraction de données d'un tableau pour mettre dans un autre VBA

bonjour

je reviens vers vous avec un soucis de VBA

voir exemple

je cherche à faire la recherche du N°carte du listing de la feuil1 dans la table de Source , afin de mettre à jour la date et quantité d'achat (uniquement colonne E ou F sur Feuil1) dans la feuille Source

En cas de non présence du N° carte, création d'une nouvelle ligne avec les nouvelles infos

Ceci déclencher par un bouton car le listing Feuil1 peut changer avec le temps (notamment en longueur)

Cela fait quelques jours que je suis dessus, je vois ce qu'il faut faire en formules mais ne maîtrise pas assez le VBA pour le transposer

D'avance merci à vous du temps et de l'aide

Bonjour,

je n'ai pas compris comment doit se faire la màj

voici un exemple pour trouver le numéro de ligne correspondante au nom,

lig = 6  'recherche du nom présent sur la ligne 6 de Source
nom = Sheets("Source").Cells(lig, 2) & " " & Sheets("Source").Cells(lig, 3)
t = "MATCH(""" & nom & """,Feuil1!C:C,0)"
No_lig = Evaluate(t)  ' = No de ligne sur Feuil1

je vais essayer d'être plus clair

la mise a jour se fait en fonction du numéro de carte et cela écris la date d'achat et la quantité

re,

à tester,

Sub Test1()
Set sh1 = Sheets("Source")
Set sh2 = Sheets("Feuil1")

rw2 = sh2.Cells(31, "A").End(xlUp).Row
For n = 9 To rw2
    If Not IsError(Application.Match(sh2.Cells(n, "B"), sh1.Range("A:A"), 0)) Then
        lig = Application.Match(sh2.Cells(n, "B"), sh1.Range("A:A"), 0)
        sh1.Cells(lig, "D") = Application.Sum(sh2.Cells(n, "E").Value + sh2.Cells(n, "F").Value)
    Else
        rw1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row + 1
        sh1.Cells(rw1, "A") = sh2.Cells(n, "B").Value

        'attention : ne gère pas les noms composés qui sont séparé par un espace
        nom = Split(sh2.Cells(n, "C").Value, " ")
        sh1.Cells(rw1, "B") = nom(0)
        sh1.Cells(rw1, "C") = nom(1)

        sh1.Cells(rw1, "D") = Application.Sum(sh2.Cells(n, "E").Value + sh2.Cells(n, "F").Value)
        sh1.Cells(rw1, "E") = sh2.Cells(n, "A").Value

    End If
Next n
End Sub

merci beaucoup

j'essaie de comprendre, l'adapte et reviens vers vous

encore merci

bonjour

je reviens

je viens de test et cela fonctionne presque nickel, 2 choses:

  • la date d'achat ne se met pas à jour (extraite de la feuil1 en colonne A)
  • en cas d'absence dans le listing de la Source, il faut pouvoir le rajouter à la fin du linsting (chose a rajouter)

Pour les noms longs, le mieux est de faire la recherche sur la colonne N° Carte, ainsi pas de problème

j'essaie toujours de comprendre la boucle écrite

re,

à tester,

Sub Test1()
Set sh1 = Sheets("Source")
Set sh2 = Sheets("Feuil1")

rw2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row - 1
For n = 9 To rw2
  If sh2.Cells(n, "A") <> "" Then
    If Not IsError(Application.Match(sh2.Cells(n, "B"), sh1.Range("A:A"), 0)) Then
        lig = Application.Match(sh2.Cells(n, "B"), sh1.Range("A:A"), 0)
        sh1.Cells(lig, "D") = Application.Sum(sh2.Cells(n, "E").Value + sh2.Cells(n, "F").Value)
        sh1.Cells(lig, "E") = sh2.Cells(n, "A").Value
    Else
        rw1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row + 1
        sh1.Cells(rw1, "A") = sh2.Cells(n, "B").Value

        'attention : ne gère pas les noms composés qui sont séparé par un espace
        nom = Split(sh2.Cells(n, "C").Value, " ")
        sh1.Cells(rw1, "B") = nom(0)
        sh1.Cells(rw1, "C") = nom(1)

        sh1.Cells(rw1, "D") = Application.Sum(sh2.Cells(n, "E").Value + sh2.Cells(n, "F").Value)
        sh1.Cells(rw1, "E") = sh2.Cells(n, "A").Value

    End If
  End If
Next n
End Sub
Rechercher des sujets similaires à "soucis extraction donnees tableau mettre vba"