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

anasimo

XLDnaute Occasionnel
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.

capture22.JPG

......

Capture23.JPG


Merci beaucoup
 

Pièces jointes

  • vendeurs.xlsx
    11.1 KB · Affichages: 11
Dernière édition:

danielco

XLDnaute Accro
Essaie (non testé) :
VB:
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
 

danielco

XLDnaute Accro
Essaie comme ça :

VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 724
Membres
110 552
dernier inscrit
jasson