Macro transfert sous conditions

Question

Bonjour à tous,

Je sollicite votre aide pour un petit soucis de macro. J'avoue que je suis un peu dépassé par le sujet.
Je travaille sur Excel 2011 sur mac.

Alors voilà, je dois créer un outil qualité et le principe est de faire basculer les informations d'un tableau vers un autre sous certaines conditions. (Peut-on mettre une PJ pour que je vous montre le schéma du tableau ?)
En fait, j'aimerai que les risques sur la feuille 1 se transfère en feuille 2 selon le schéma suivant :
Sur une nouvelle ligne
- Type = Type de constat
- Tous = Process
- Entité concernée = Entité
- Description du risque = Description de la non conformité ou suggestion d'amélioration
- Conséquence / Dommage = Analyse des causes / conséquences / effets attendus
- Priorité = Criticité
Et enfin dans la date d'enregistrement la date du jour.

Mais ce report doit se faire uniquement pour les priorités Mineure ou Majeure.
Petite précision (je ne sais pas si ça a un impact) dans la version originale du tableau, la feuille 2 est masquée et protégée par un mdp.

J'ai essayé de me plonger dedans depuis quelques jours, mais le VBA devient très vite du chinois pour moi 
Je m'en remet donc à des mains plus expertes !

Un grand merci pour vos réponses et le travail formidable que vous faites sur ces forums !

Cordialement,

Ad

Frenchie83 · Answer

Bonjour
Peut-on mettre une PJ pour que je vous montre le schéma du tableau ? Oui, c'est même conseillé pour espérer une réponse.
Attention, une image de votre fichier ne nous sert pas, puisqu'il nous faut reconstruire le fichier. Joignez votre fichier exempt de toutes données confidentielles.

Pour déposer un fichier en pièce jointe, utilisez Cjoint.com, 
aller sur "www.cjoint.com"
-clic sur "parcourir"
-sélectionnez le fichier à envoyer
-clic sur "créer le lien Cjoint" (bouton en bas)
-clic droit sur le lien proposé, et sélectionnez "copier l'adresse du lien"
-sur votre nouvelle demande CCM, -clic droit coller
Cdlt

OPQ · Answer

Bonjour,

Merci beaucoup ! Voilà le lien du tableau en question.

http://www.cjoint.com/c/GDtjQSOW05Q


Cordialement,

Adrien

Frenchie83 · Answer

Bonjour
Voici
https://www.cjoint.com/c/GDtnsPedoXk
Exécutez la macro en cliquant sur le bouton. A la fin du test, la feuille 2 est masquée et protégée avec le MDP xx.
Dans la macro, à la ligne suivante:
    sh2.Protect Password:="xx", DrawingObjects:=True, Contents:=True, Scenarios:=True
 remplacez xx par votre mot de passe.
Cdlt

OPQ · Answer

Waow !

Merci pour cette réponse rapide et pour votre travail ! C'est vraiment top !

Encore une petite question avant de mettre le sujet en résolu, est-il possible d’empêcher les lignes déjà copiées de se copier de nouveau ?

Par exemple, si jamais un jour je rajoute des lignes dans le tableau en feuille 1 et que je relance la macro, dois-je forcement conserver les lignes précédemment copiées, qui du coup seront en double dans le tableau en feuille 2 ?

Frenchie83 · Answer

Remplacez le code précédent par celui-ci.
Sub Recopie()
    Application.ScreenUpdating = False
    Set Sh1 = Sheets("Feuil1")
    Set Sh2 = Sheets("Feuil2")
    'Affichage feuille 2 et Suppression mot de passe
    Sh2.Visible = True
    NewligSh2 = Sh2.[B100000].End(xlUp).Row + 1
   
    DerligSh1 = Sh1.[B100000].End(xlUp).Row
    Sh2.Select
    ActiveSheet.Unprotect
    For i = 13 To DerligSh1
        If Sh1.Cells(i, "O") = "Mineure" Or Sh1.Cells(i, "O") = "Majeure" Then
            'Vérification présence du numéro
            Num = Sh1.Cells(i, "B")
            Set c = Sh2.Columns("B").Find(Num, LookIn:=xlValues)
            If c Is Nothing Then
                Sh2.Cells(NewligSh2, "B") = Sh1.Cells(i, "B")
                Sh2.Cells(NewligSh2, "F") = Sh1.Cells(i, "C")
                Sh2.Cells(NewligSh2, "G") = Sh1.Cells(i, "D")
                Sh2.Cells(NewligSh2, "E") = Sh1.Cells(i, "E")
                Sh2.Cells(NewligSh2, "K") = Sh1.Cells(i, "F")
                Sh2.Cells(NewligSh2, "O") = Sh1.Cells(i, "G")
                Sh2.Cells(NewligSh2, "P") = Sh1.Cells(i, "O")
                Sh2.Cells(NewligSh2, "C") = Date
                NewligSh2 = NewligSh2 + 1
            End If
        End If
    Next i
    Sh2.Protect Password:="xx", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWindow.SelectedSheets.Visible = False
    Sh1.Select
End Sub
Cdlt

Macro transfert sous conditions

5 réponses

Discussions similaires

Newsletters