VBA - Mise a jour de deux fichiers

[Bens7]

Bonjour a tous !!
Etant debutant en VBA je me permet de vous postez mon probleme j'ai cherche sur plusieurs forum sans succes.
J'ai un fichier SOURCE et un CIBLE .
En gros avec un bouton je souhaite mettre a jour 3 collones de CIBLE par apport a SOURCE et ce en verifiant le numero de facture .

Je vous est mis les 2 fichiers en pieces jointes ... je pensse que cela sera plus clair.
Je vous remercie vraiment pour votre soutien je galere .....
(ps: 2000 ligne, donc obliger VBA j'ai essayer avec EQUIV, INDEX.... ca plante ...)

 

[gosselien]

Re : VBA - Mise a jour de deux fichiers

Bonjour,

avec les 2 fichiers dans le même répertoire et ouverts, c'est facile

P.

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Merci pour votre reponsse mais j'ai besoin absolument en vba je modifie apres moi meme les cases donc les formules ce suprime.. et c'est tres long j'ai besoin en vba ...

Merci

 

[klin89]

Re : VBA - Mise a jour de deux fichiers

Bonsoir Bens7, gosselien, le forum

A adapter à ton cas :

Option Explicit

Sub test()
Dim a, i As Long, j As Long, w
a = Sheets(1).Range("a1").CurrentRegion.Value   'source
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        ReDim w(1 To UBound(a, 2))
        For i = 2 To UBound(a, 1)
            For j = 1 To UBound(a, 2)
                w(j) = a(i, j)
            Next
            .Item(a(i, 1)) = w
        Next
        a = Sheets(2).Range("a1").CurrentRegion.Value  'cible
        For i = 2 To UBound(a, 1)
            If .Exists(a(i, 1)) Then
                For j = 3 To UBound(a, 2)
                    a(i, j) = .Item(a(i, 1))(j)
                Next
            End If
        Next
    End With
    'cible
    Sheets(2).Range("a1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Pour l'exemple, j'ai placé tes 2 tableaux (source et cible) dans le même classeur sur 2 feuilles différentes.
Tes données à partir de A1 avec en-têtes.

klin89

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Merci beaucoup pour l'effort mais desole les 2 fichiers sont bien separe:
- CIBLE est pour un service
- SOURCE est mon fichier
je ne peux pas les reunir sans le meme fichier est les emplacement des donnes sont bien dans les collonnes exact ou je les ai palce ...

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Un ptit up svp tres urgent merci

 

[gosselien]

Re : VBA - Mise a jour de deux fichiers



plus de 400 messages et débutant ???

étonnant , mais ceci dit , je suis souvent ici et j'en apprends toutes les semaines grâce à des gens hyper calés

P.

 

[klin89]

Re : VBA - Mise a jour de deux fichiers

Re Bens7,

Pour faire simple :
Dans le même dossier, place tes 2 classeurs (source et cible)
Tes données figurant bien dans la première feuille de chaque classeur.

1 ère solution : on place la macro dans le classeur cible.

Option Explicit

Sub test()
Dim a, i As Long, j As Long, w
    'source
    With Workbooks.Open(ThisWorkbook.Path & "\SOURCE.xlsx")
        a = .Sheets(1).Range("L1").CurrentRegion.Value
        .Close False
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        ReDim w(1 To UBound(a, 2))
        For i = 2 To UBound(a, 1)
            For j = 1 To UBound(a, 2)
                w(j) = a(i, j)
            Next
            .Item(a(i, 1)) = w
        Next
        'cible
        a = ThisWorkbook.Sheets(1).Range("R1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .Exists(a(i, 1)) Then
                For j = 3 To UBound(a, 2)
                    a(i, j) = .Item(a(i, 1))(j)
                Next
            End If
        Next
    End With
    'cible
    With ThisWorkbook.Sheets(1)
        .Range("R1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End With
End Sub

2 ème solution : on place la macro dans le classeur source.

Option Explicit

Sub test()
Dim a, i As Long, j As Long, w, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    'source
    a = ThisWorkbook.Sheets(1).Range("L1").CurrentRegion.Value
    ReDim w(1 To UBound(a, 2))
    For i = 2 To UBound(a, 1)
        For j = 1 To UBound(a, 2)
            w(j) = a(i, j)
        Next
        dico(a(i, 1)) = w
    Next
    'cible
    With Workbooks.Open(ThisWorkbook.Path & "\Cible.xlsm")
        a = .Sheets(1).Range("R1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If dico.Exists(a(i, 1)) Then
                For j = 3 To UBound(a, 2)
                    a(i, j) = dico(a(i, 1))(j)
                Next
            End If
        Next
        With .Sheets(1)
            .Range("R1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
        End With
    End With
End Sub

klin89

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Desole je n'ai pas pu repondre pendant un certain temp ... gros soucci personel.
Alors j'ai fait le text j'ai opter pour la version 2 (vba dans la cible)
tous marche mais le soucci c'est que lorsque je complete mais collone dans source bah la ca marche plus du tout ....
en gros si la collone q est remplie ca recupere rien je vous joint les fichier avec la modif...

 

[klin89]

Re : VBA - Mise a jour de deux fichiers

Re Bens7,

A toi de tester.
Dans un module standard.

Option Explicit

Sub test()
Dim a, i As Long, j As Long, w
    'source
    With Workbooks.Open(ThisWorkbook.Path & "\SOURCE.xlsx")
        a = .Sheets(1).Range("A1").CurrentRegion.Columns("r:v").Value
        .Close False
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        'ReDim w(1 To UBound(a, 2))
        ReDim w(1 To 5)
        For i = 2 To UBound(a, 1)
            For j = 1 To 5
                w(j) = a(i, j)
            Next
            .Item(a(i, 1)) = w
        Next
        'cible
        a = ThisWorkbook.Sheets(1).Range("R1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .Exists(a(i, 1)) Then
                For j = 1 To UBound(a, 2)
                    a(i, j) = .Item(a(i, 1))(j)
                Next
            End If
        Next
    End With
    'cible
    With ThisWorkbook.Sheets(1)
        .Range("R1").Resize(UBound(a, 1), UBound(a, 2)).FormulaLocal = a
    End With
End Sub

klin89

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Merci ça marche nikel !
Par contre ...si puis je me permettre est ce possible d'effectuer la meme operation meme si le fichier est ouvert que cela fonctionne aussi pas juste si le fichier est fermé c'est très handicapant...
Merci vraiment

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Je suis désolé mais une fois les 2 fichiers remplie ça ne marche pas...

 

[gosselien]

Re : VBA - Mise a jour de deux fichiers

Bonjour,

si tes exemples sont <> de tes fichiers réels, (ça arrive trop souvent ici), il faudra mettre un petit morceau de ceux-ci (anonymisé au passage).

P.

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Ce sont les même fichiers que en haut sauf que ci toutes les collines précédente sont remplis dans source rien ne se passe

 

[Bens7]

Re : VBA - Mise a jour de deux fichiers

Avez vous pu voir le problème?