Macro pour vérifier un élément nouveau dans la liste

[anasimo]

bonjour
J'ai une feuille "utilisateurs" où sont inscrits les numéros des vendeurs .......dans la feuille 2 "BD_CLMT je vais copier quotidiennement un fichier avec plus de 2000 lignes...je cherche une macro qui me permet de vérifier s'il y a un nouveau vendeur qui apparaît et qui ne figure pas dans la liste figurant dans la feuille "utilisateurs". Le but est de le dénicher et l'ajouter à la liste.

......

Merci beaucoup

 

[danielco]

Bonjour,

Que veux-tu ? S'il y a de nouveaux vendeurs, un msgbox par feuille ?

Daniel

 

[anasimo]

ah oui ça sera parfait ...merci beaucoup

 

[danielco]

Essaie (non testé) :

Sub Alerte()
  Dim Ligne As Long, C As Range, Plage As Range, Tabl As Variant, I As Long, Teste As Boolean
  Dim Tot As Long
  With Sheets("BD_CLMT")
    Set Plage = .Range("J2", .Cells(.Rows.Count, 10).End(xlUp))
  End With
  With Sheets("Utilisateurs")
    Ligne = .Cells(.Rows.Count, 8).End(xlUp).Row
    Tabl = Application.Transpose(.Range("H2:H" & Ligne))
    For Each C In Plage
      For I = 1 To UBound(Tabl)
        Teste = False
        If C = Tabl(I) Then
          Teste = True
          Exit For
        End If
      Next I
      If Teste = False Then
        Ligne = Ligne + 1
        .Cells(Ligne, 8) = C.Value
        Tabl = Application.Transpose(.Range("H2:H" & Ligne))
        Tot = Tot + 1
      End If
    Next C
    If Tot > 0 Then
      MsgBox Tot & " nouveaux vendeur(s)"
    Else
      MsgBox "Pas de nouveau vendeur"
    End If
  End With
  With Sheets("CF")
    Set Plage = .Range("F2", .Cells(.Rows.Count, 6).End(xlUp))
  End With
  With Sheets("Utilisateurs")
    Ligne = .Cells(.Rows.Count, 8).End(xlUp).Row
    Tabl = Application.Transpose(.Range("H2:H" & Ligne))
    For Each C In Plage
      For I = 1 To UBound(Tabl)
        Teste = False
        If C = Tabl(I) Then
          Teste = True
          Exit For
        End If
      Next I
      If Teste = False Then
        Ligne = Ligne + 1
        .Cells(Ligne, 8) = C.Value
        Tabl = Application.Transpose(.Range("H2:H" & Ligne))
        Tot = Tot + 1
      End If
    Next C
    If Tot > 0 Then
      MsgBox Tot & " nouveaux vendeur(s)"
    Else
      MsgBox "Pas de nouveau vendeur"
    End If
  End With
  With Sheets("CCT")
    Set Plage = .Range("L2", .Cells(.Rows.Count, 12).End(xlUp))
  End With
  With Sheets("Utilisateurs")
    Ligne = .Cells(.Rows.Count, 8).End(xlUp).Row
    Tabl = Application.Transpose(.Range("H2:H" & Ligne))
    For Each C In Plage
      For I = 1 To UBound(Tabl)
        Teste = False
        If C = Tabl(I) Then
          Teste = True
          Exit For
        End If
      Next I
      If Teste = False Then
        Ligne = Ligne + 1
        .Cells(Ligne, 8) = C.Value
        Tabl = Application.Transpose(.Range("H2:H" & Ligne))
        Tot = Tot + 1
      End If
    Next C
    If Tot > 0 Then
      MsgBox Tot & " nouveaux vendeur(s)"
    Else
      MsgBox "Pas de nouveau vendeur"
    End If
  End With
End Sub

Daniel

 

[anasimo]

oui ça marche.....il ajoute les vendeurs non présents.
mais il y a des erreurs dans msgbox....il annonce de nvx vendeurs même s'il n'existe pas surtout pour le CF et CCT

 

[danielco]

Essaie comme ça :

Sub Alerte()
  Dim Ligne As Long, C As Range, Plage As Range, Tabl As Variant, I As Long, Teste As Boolean
  Dim Tot As Long
  With Sheets("BD_CLMT")
    Set Plage = .Range("J2", .Cells(.Rows.Count, 10).End(xlUp))
  End With
  With Sheets("Utilisateurs")
    Ligne = .Cells(.Rows.Count, 8).End(xlUp).Row
    Tabl = Application.Transpose(.Range("H2:H" & Ligne))
    Tot = 0
    For Each C In Plage
      For I = 1 To UBound(Tabl)
        Teste = False
        If C = Tabl(I) Then
          Teste = True
          Exit For
        End If
      Next I
      If Teste = False Then
        Ligne = Ligne + 1
        .Cells(Ligne, 8) = C.Value
        Tabl = Application.Transpose(.Range("H2:H" & Ligne))
        Tot = Tot + 1
      End If
    Next C
    If Tot > 0 Then
      MsgBox Tot & " nouveaux vendeur(s)"
    Else
      MsgBox "Pas de nouveau vendeur"
    End If
  End With
  With Sheets("CF")
    Set Plage = .Range("F2", .Cells(.Rows.Count, 6).End(xlUp))
  End With
  With Sheets("Utilisateurs")
    Ligne = .Cells(.Rows.Count, 8).End(xlUp).Row
    Tabl = Application.Transpose(.Range("H2:H" & Ligne))
    Tot = 0
    For Each C In Plage
      For I = 1 To UBound(Tabl)
        Teste = False
        If C = Tabl(I) Then
          Teste = True
          Exit For
        End If
      Next I
      If Teste = False Then
        Ligne = Ligne + 1
        .Cells(Ligne, 8) = C.Value
        Tabl = Application.Transpose(.Range("H2:H" & Ligne))
        Tot = Tot + 1
      End If
    Next C
    If Tot > 0 Then
      MsgBox Tot & " nouveaux vendeur(s)"
    Else
      MsgBox "Pas de nouveau vendeur"
    End If
  End With
  With Sheets("CCT")
    Set Plage = .Range("L2", .Cells(.Rows.Count, 12).End(xlUp))
  End With
  With Sheets("Utilisateurs")
    Ligne = .Cells(.Rows.Count, 8).End(xlUp).Row
    Tabl = Application.Transpose(.Range("H2:H" & Ligne))
    Tot = 0
    For Each C In Plage
      For I = 1 To UBound(Tabl)
        Teste = False
        If C = Tabl(I) Then
          Teste = True
          Exit For
        End If
      Next I
      If Teste = False Then
        Ligne = Ligne + 1
        .Cells(Ligne, 8) = C.Value
        Tabl = Application.Transpose(.Range("H2:H" & Ligne))
        Tot = Tot + 1
      End If
    Next C
    If Tot > 0 Then
      MsgBox Tot & " nouveaux vendeur(s)"
    Else
      MsgBox "Pas de nouveau vendeur"
    End If
  End With
End Sub

Daniel

 

[anasimo]

oui marche très bien maintenant ....Merci beaucoup Daniel

NB: Comment mettre le sujet comme résolu

 

[danielco]

Clique sur "XL 2013", à côté du titre de la discussion, et choisis "Résolu".

Daniel