[Macro Excel] Copie de formules etc...

Bonjour,

J'ai fait une macro basique via l'enregistreur pour ajouter un nouvel utilisateur dans une liste et changé qques petits trucs.

On doit renseigner 8 champs et 7 autres se font automatiquement avec des formules de recherchev et de si.

Mon problème vient d'une part que je sélectionne une plage maxi d'utilisateurs à rajouter (46) et cette plage contient les formules qui sont recopiées en valeur sur la liste des utilisateurs. De ce fait, même si il n'y a pas d'utilisateur à ajouter, il y a toujours des formules qui donnent des cases où il n'y a rien dans la liste, mais qui sont comptées comme des cellules non-vides.

Après ça, il serait peut-être judicieux de juste chercher les colonnes où on a rempli qqc pour éviter la recopie de toute les formules.

Comment puis-je faire ?
Voici déjà ma la mini-macro

Sub AjoutUsers()

Application.ScreenUpdating = False

    MsgBox ("Merci d'attendre la fin de la mise à jour")
    Worksheets("Utilisateurs").Select
    Selection.AutoFilter Field:=3 'Remettre le filtre auto à 0
    Worksheets("Ajout Users").Select
    Range("A5:O50").Select 'Sélectionner la plage maxi d'utilisateurs à ajouter
    Selection.Copy
    Worksheets("Utilisateurs").Activate
    Range("A" & Range("A65535").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Coller la sélection d'utilisateurs
    'Vider les cellules renseignées
    Worksheets("Ajout Users").Select
    Range("C5:C50").Select
    Selection.ClearContents
    Range("G5:G50").Select
    Selection.ClearContents
    Range("H5:H50").Select
    Selection.ClearContents
    Range("I5:I50").Select
    Selection.ClearContents
    Range("J5:J50").Select
    Selection.ClearContents
    Range("K5:K50").Select
    Selection.ClearContents
    Range("M5:M50").Select
    Selection.ClearContents
    Range("N5:N50").Select
    Selection.ClearContents
    Range("A1").Select
    MsgBox ("Utilisateur(s) ajouté(s)")

Application.ScreenUpdating = True

End Sub


Question bonus :
Je souhaiterais appliquer une condition au rajout d'un utilisateur dans la liste (nom et matricule précisemment). Comment puis-je indiquer que la macro doit s'arrêter si matricule + nom sont retrouvés dans la liste ? Et est-il possible que nom+matricule s'affichent dans une msgbox ?

J'espère avoir été assez clair dans mes explications.
Merci d'avance pour vos réponses qui m'aideront beaucoup

6 réponses

  1. Bonjour,
    Est-ce que: le nom en colonne A et le matricule en colonne B ?
    Pour la questions bonus; pas de doublon dans [Worksheets("Utilisateurs")] donc le message pas nécessaire; Oui / Non !
    0
    1. En gros on a pour les 15 colonnes :

      Réseau|Région|DA|Libellé|Matricule OP@LE|Matricule RH|Nom utilisateur windows|Titre|Prénom|Nom|N° Téléphone|Adresse Mail|Fonction|Périmètre Achat|Procurement management roles

      On renseigne tous les champs en gras, et les autres champs se remplissent automatiquement via des formules =si(estvide(nom);"";recherchev(....)). Les cellules recopiées en valeur sur l'autre feuille sont vides mais ne sont pas considérées comme tel.

      La condition serait que sur le nouvel utilisateur soit fait un test sur le DA + Matricule (un utilisateur peut être sur plusieurs domaines d'activité).
      0
      1. Bonjour,
        Merci pour l'information.
        En principe il suffirait de copier/coller que les colonnes [C,G :K,M :N] car les autres sont renseignées par des formules qui sont, forcément, déjà sur la feuille [Utilisateurs] (il suffit de les tirer selon la nouvelle grandeur).
        Est-vous d'accord ?
        Les doublons sont sur DA+Matricule, oui mais quel matricule est valable colonne E ou F ?
        0
        1. Bonjour,
          Essayer cette procédure à mettre dans le module feuille [Utilisateurs]:
          Sub AjoutUtilisateurs()
          Dim cel As Range
          Dim doublon
          Application.ScreenUpdating = False
          '*** variable de contrôle doublon
          deli = WorksheetFunction.CountA(Columns(3))
          lico = deli + 1
          ReDim doublon(deli)
          For c = 2 To deli
              doublon(c - 2) = Cells(c, 3) & Cells(c, 6)
          Next c
          
          For Each cel In Worksheets("Ajout Users").Range("c5:c50")
          ' contrôl si doublon
              For d = 0 To UBound(doublon)
                  If doublon(d) = (cel.Value & cel.Offset(0, 3)) Then
                  '    MsgBox "doublon"
                      GoTo Suite
                  End If
              Next d
          ' ligne valable
          
          Rows(lico) = Worksheets("Ajout Users").Rows(cel.Row).Value
          lico = lico + 1
          Suite:
          Next cel
          
          'Transfère les éléments du tableau dans la feuille de calcul
          '    Range(Cells(1, 1), Cells(UBound(NomTableau, 1), UBound(NomTableau, 2))) = NomTableau
          ' incrémenter les formules
          deb = deli + 1: fin = lico
          
          Range("A" & deli & ":B" & deli).AutoFill Destination:=Range("A" & deli & ":B" & lico - 1), Type:=xlFillDefault
          Range("D" & deli & ":E" & deli).AutoFill Destination:=Range("D" & deli & ":E" & lico - 1), Type:=xlFillDefault
          Range("L" & deli & ":L" & deli).AutoFill Destination:=Range("L" & deli & ":L" & lico - 1), Type:=xlFillDefault
          Range("O" & deli & ":O" & deli).AutoFill Destination:=Range("O" & deli & ":O" & lico - 1), Type:=xlFillDefault
              
           'Vider les cellules renseignées
          Worksheets("Ajout Users").Range("C5:C50,G5:K50,M5:N50").ClearContents
          
          MsgBox ("Utilisateur(s) ajouté(s)")
          Application.ScreenUpdating = True
          End Sub
          0
          1. Les conditions me donnaient une erreur. Au final j'ai pu exploiter un collègue qui passait dans le coin et ça a donné ça :

            Sub AjoutUsers()

            Dim texte As String
            Dim doublonTrouve As Boolean

            doublonTrouve = False
            Application.ScreenUpdating = False

            MsgBox ("Merci d'attendre la fin de la mise à jour")
            Worksheets("Utilisateurs").Select
            Selection.AutoFilter Field:=3 'Remettre le filtre auto à 0

            nombreligne = 0
            ligne = 5

            Do While Worksheets("Ajout Users").Cells(ligne, 3) <> ""

            ligne = ligne + 1
            nombreligne = nombreligne + 1

            Loop

            ligne = 1

            Do While Worksheets("Utilisateurs").Cells(ligne, 1).Value <> "" And Worksheets("Utilisateurs").Cells(ligne, 1).Value <> " "

            For i = 1 To nombreligne

            If Worksheets("Utilisateurs").Cells(ligne, 3).Value = Worksheets("Ajout Users").Cells(i + 4, 3).Value _
            And Worksheets("Utilisateurs").Cells(ligne, 5).Value = Worksheets("Ajout Users").Cells(i + 4, 5).Value Then

            texte = texte + "L'utilisateur " & Worksheets("Utilisateurs").Cells(ligne, 5).Value & " existe déjà sur le site " & Worksheets("Utilisateurs").Cells(ligne, 3).Value
            doublonTrouve = True

            End If

            Next i

            ligne = ligne + 1

            Loop

            If doublonTrouve = False Then

            Worksheets("Ajout Users").Select
            Range("A5:O50").Select 'Sélectionner la plage maxi d'utilisateurs à ajouter
            Selection.Copy

            Worksheets("Utilisateurs").Activate

            ligne = 1

            Do While Cells(ligne, 1).Value <> "" And Cells(ligne, 1).Value <> " "

            ligne = ligne + 1

            Loop
            Cells(ligne, 1).Select

            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False 'Coller la sélection d'utilisateurs

            MsgBox ("Utilisateur(s) ajouté(s)")

            Else

            MsgBox texte

            End If

            'Vider les cellules renseignées
            Worksheets("Ajout Users").Range("C5:C50,G5:K50,M5:N50").ClearContents

            Application.ScreenUpdating = True

            End Sub

            Merci beaucoup d'avoir planché dessus en tout cas.

            Cordialement
            0
            1. Bonjour,
              J'ai essayez votre code.
              Il y a déjà une erreur d'exécution `1004' qui se produit et ensuite dans la feuille des utilisateurs les doublons ne sont pas supprimés.
              Enfin selon se que j'ai compris.
              Il serait intéressant pour moi de savoir ou se produit l'erreur avec mon code !
              0