Macro transfert sous conditions

Fermé
OPQ - 7 avril 2017 à 09:19
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 - 19 avril 2017 à 17:54
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
A voir également:

5 réponses

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
8 avril 2017 à 06:34
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
0
Bonjour,

Merci beaucoup ! Voilà le lien du tableau en question.

http://www.cjoint.com/c/GDtjQSOW05Q


Cordialement,

Adrien
0
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
19 avril 2017 à 15:24
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
0
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 ?
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
19 avril 2017 à 17:54
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
0