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

comparaison entre 2 fichiers VBA

MELL90

XLDnaute Nouveau
Bonjour,

Je suis désolé pour le dérangement, je débute en VBA et je réalise mon premier code..

En effet j’ai passé toute la matinée pour chercher comment faire une comparaison entre deux fichiers Excel qui contient des informations différentes sauf le nom et le prénom en commun.

J’ai besoin de faire une comparaison entre les deux fichiers A et B et si je trouve une ligne dans A qui ne se trouve pas dans le fichier B je l’insert dans B..

J’ai trouvé plusieurs lignes de codes sur internet j’ai essayé de l’adapter selon mes besoins mais sans résultat puisque je débute en VBA …et je ne comparant pas trop les lignes de code..

Quelqu’un peut ’aider s’il vous pelait.
 

vgendron

XLDnaute Barbatruc
Bonjour

pas sur de bien comprendre..
si tu ajoutes une ligne dans IC (fichier d'origine), il faut evidemment relancer manuellement la macro (elle ne se lance pas toute seule)
si tu supprimes une ligne dans IC: et qu'elle était dans le fichier Piste.. et bien. elle y restera.
le but était de regarder le fichier IC, et si une des lignes de IC n'est PAS dans Piste, alors; on la met.
 

MELL90

XLDnaute Nouveau
@vgendron
Le problème lorsque j'ajoute une ligne dans IC qui ne se trouve pas dans piste et je relance manuellement ma macro rien ne se passe ...
il faut que j'efface les lignes rajoutées lors de la dérinere mise à jour et que je relance la macro .
 

vgendron

XLDnaute Barbatruc
Ha oui. je viens de voir. une coquille ou deux dans le code..
Grrrrr...quand on te dit que plusieurs lignes sont nécéssaires....

VB:
Sub fusion()
Dim DataSource(), DataDest()
Set FicSource = Workbooks("IC.xlsm")
Set FicDest = Workbooks("Piste.xlsx")

TailleSource = FicSource.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
TailleDest = FicDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Dim ListToCopy(1, 16) 'ligne à recopier

ReDim DataSource(TailleSource + 1, 22) 'contient la ligne d'entete
ReDim DataDest(TailleDest, 16) 'Contient la ligne à copier

DataSource = FicSource.Sheets("Sheet1").Range("A1:V" & TailleSource).Value
DataDest = FicDest.Sheets("Sheet1").Range("A1:P" & TailleDest).Value

For i = LBound(DataSource) + 1 To UBound(DataSource)
    Trouve = False
    For j = LBound(DataDest) + 1 To UBound(DataDest)
        If DataDest(j, 3) = DataSource(i, 5) Then 'on cherche le Nom Prénom
            Trouve = True
        End If
    Next j
        If Trouve = False Then 'si on a pas trouvé - on récupère les données de la ligne
            'NewTaille = UBound(DataDest) + 1
            'ReDim DataDest(NewTaille, 16)
            ListToCopy(1, 1) = "-" 'BU 'on met un - pour éviter d'écraser la dernière ligne au fur et à mesure
            ListToCopy(1, 2) = DataSource(i, 2) 'TU
            ListToCopy(1, 3) = DataSource(i, 5) 'Nom Prénom
            ListToCopy(1, 4) = DataSource(i, 9) 'Métier
            ListToCopy(1, 5) = DataSource(i, 2) 'TU
            ListToCopy(1, 6) = DataSource(i, 18) 'Date Dispo
            ListToCopy(1, 7) = DataSource(i, 8) 'DC OK
            ListToCopy(1, 8) = DataSource(i, 13) 'PPT OK
            ListToCopy(1, 9) = DataSource(i, 20) 'Salaire
            ListToCopy(1, 10) = DataSource(i, 4) 'BM
            ListToCopy(1, 11) = DataSource(i, 3) 'TM
            ListToCopy(1, 12) = DataSource(i, 17) 'Client
            ListToCopy(1, 13) = "" 'BM/TM
            ListToCopy(1, 14) = "" 'Date Dernier Statut
            ListToCopy(1, 15) = "" 'Etat
            ListToCopy(1, 16) = "" 'Action complémentaire
           
            FicDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = ListToCopy(1, 1)
            For k = 2 To 16
                    FicDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(0, k - 1) = ListToCopy(1, k)
            Next k
        End If
Next i
End Sub
 

Discussions similaires

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