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

33extrac-macro.zip (19.38 Ko)

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

shtouil143 a écrit :

Si on trouve (Di :Ei) différent de (Dj :Ej)

ne veut rien dire

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.

extrac

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 Sub

Encore 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 Sub

oui j'avais corrigé sur le mien, j'ai pas du copier le bon du coup!

merci de la correction

Rechercher des sujets similaires à "comparer feuilles copier ecarts"