Comparer 2 feuilles et copier les écarts
Bonjour,
je me suis pas mal baladé sur le forum pour trouver comment réaliser une macro qui compare des données d'une feuille A avec celle d'une feuille B et qui rajoute dans la feuille B les écarts. Beaucoup de posts traitent du sujet et y ressemble mais mes compétences en VBA étant très limitées je n'arrive pas à m'en sortir!
En gros:
J’ai un tableau de données dans la feuille1 avec plusieurs critères définissant chaque ligne. Dans la feuille2 j’extrais quotidiennement des données sur le même format que le tableau de la feuille1 qui est en somme une M.A.J. J’aimerais comparer le binôme de cellule (Di :Ei) de la Feuille2 au couple (Dj :Ej) de la feuille1 et dissocier plusieurs cas :
- Si on trouve (Di :Ei) = (Dj :Ej) on laisse couler
- Si on trouve (Di :Ei) différent de (Dj :Ej) on surligne en rouge (Dj :Ej) (donc dans la feuille1)
- Si on ne trouve pas de (Di :Ei) = (Dj :Ej) alors on copie (Ai :Hi) a la suite de la dernière ligne du tableau en feuille1 (et le mettre en vert ?)
J’ai essayé de faire deux boucles FOR….NEXT sur les i et j pour balayer les tableaux, en vain.
J’ai essayé de faire une boucle pour copier toute la feuille2 en feuille1 (commençons petit) mais déjà la ça coince.
Sur le papier ça semble pas compliqué mais à réaliser l'affaire est toute autre !
J'espère avoir été clair dans mes explications et si quelqu'un pouvait m'aider je vous en serais reconnaissant! Par avance merci!
Ps: en Pj mon fichier excel
Bonjour
Une question
Soit on trouve le couple (D:E) de la feuille 2 dans la feuille 1, soit on ne le trouve pas
mais dire
ne veut rien direshtouil143 a écrit :Si on trouve (Di :Ei) différent de (Dj :Ej)
Ou alors il y a quelque chose que tu ne dis pas
bonjour!
en fait je me suis un peu mal exprimé....et au fur et à mesure que j'écris je me rends compte qu'accompagné d'un schéma sera plus simple!
sur la colonne D c'est une valeur de référence pour un dossier, sur les autres colonnes on a des attributs de ce dossier qui ne changeront jamais, sauf pour celle de la colonne E qui peut être amenée à changer (sinon ce serait trop simple!)
d'où le fait que je voulais caractériser ces trois cas pour voir si il y a eu une mise à jour d'un dossier.
J'espère que c'est plus clair et merci d'avoir répondu.
Bonjour
Donc la colonne D contient le numéro de dossier et la colonne E l'indice de ce dossier
Numéro de dossier unique (on ne risque pas de trouver plusieurs fois le même dossier) ?
Une proposition à tester
Que dire...un grand merci!
C'est exactement ça, je viens de le tester c'est impeccable. Reste à potasser ce morceau de code pour bien le comprendre et réinvestir tout ça!
Et dire que ça t'as pris moins d'1/4h....
je met le code pour des prochains galériens comme moi si ça peut-être utile.
Sub Compare()
Dim Cel As Range
Dim J As Long, NblgF1 As Long, NbLgF2 As Long
Dim F1 As Worksheet, F2 As Worksheet
Application.ScreenUpdating = False
Set F1 = Sheets("suivi")
Set F2 = Sheets("extraction")
NblgF1 = F1.Range("A" & Rows.Count).End(xlUp).Row
NbLgF2 = F2.Range("A" & Rows.Count).End(xlUp).Row
With F2
For J = 3 To NbLgF2
Set Cel = F1.Columns("D").Find(what:=.Range("D" & J), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
' Numéro de dossier identique
If F1.Range("E" & Cel.Row) <> .Range("E" & J) Then ' Pas le même indice
F1.Range("B" & Cel.Row).Resize(1, 8).Interior.ColorIndex = 3 ' On colorise dans la page 1
End If
Else
' Dossier nouveau
NblgF1 = NblgF1 + 1
.Range("B" & J & ":I" & J).Copy F1.Range("B" & NblgF1)
F1.Range("B" & NblgF1).Resize(1, 8).Interior.ColorIndex = 4
End If
Next J
End With
End SubEncore merci à toi Banzai!
Bonjour
Désolé mais une erreur la copie c'est à partir de la colonne A
Voici le code corrigé
Option Explicit
Sub Compare()
Dim Cel As Range
Dim J As Long, NblgF1 As Long, NbLgF2 As Long
Dim F1 As Worksheet, F2 As Worksheet
Application.ScreenUpdating = False
Set F1 = Sheets("suivi")
Set F2 = Sheets("extraction")
NblgF1 = F1.Range("A" & Rows.Count).End(xlUp).Row
NbLgF2 = F2.Range("A" & Rows.Count).End(xlUp).Row
With F2
For J = 3 To NbLgF2
Set Cel = F1.Columns("D").Find(what:=.Range("D" & J), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
' Numéro de dossier identique
If F1.Range("E" & Cel.Row) <> .Range("E" & J) Then ' Pas le même indice
F1.Range("A" & Cel.Row).Resize(1, 8).Interior.ColorIndex = 3 ' On colorise dans la page 1
End If
Else
' Dossier nouveau
NblgF1 = NblgF1 + 1
.Range("A" & J & ":H" & J).Copy F1.Range("A" & NblgF1)
F1.Range("A" & NblgF1).Resize(1, 8).Interior.ColorIndex = 4
End If
Next J
End With
End Suboui j'avais corrigé sur le mien, j'ai pas du copier le bon du coup!
merci de la correction