Transferer des lignes de 4 questionnaires dans un fichier de synthése

Bonjour à tous et à toutes

J'ai un fichier de type Check List, sur lequel je cherche à Copier toutes les lignes (de 9 à 59) de la feuille « CL DR (DR) » si une réponse est « NOK » dans la colonne « J » et ceci dans le document de synthèse automatique « OIL – CR DR (DR R) », sans lignes vides

• Idem pour la feuille (lignes de 9 à 42) «CL DRE (T) » vers « OIL – CR DR (DR R) » sans lignes vides

• Idem pour les 2 autres feuilles « CF FTA (FR) » (lignes de 9 à 42) et « CL BDI (BDI) » (lignes de 9 à 28) vers ce même fichier de synthèse « OIL – CR DR (DR R) » sans lignes vides

1) J’ai essayé, dans la feuille CL DR (DR), lignes 94 à 144, d’extraire ce que je veux transférer vers le fichier de synthèse « OIL – CR DR (DR R) » sans ces lignes vides

Idem pour le fichier «CL DRE (T) », lignes 78 à 111

Idem pour le fichier « CF FTA (FR) », lignes 78 à 111

Idem pour le fichier « CL BDI (BDI) », lignes 64 à 83

2) Puis j’ai tenté de comprendre VBA sans succès pour ramener ces lignes vers ce fichier source

• De plus, je souhaiterai que même si une des questions, issues des 4 fichiers sources, qui a été transférée dans cet OIL, redevient OK, l’historique soit gardé pour tracer que ce point a bien été soldé (si besoin, entre les colonnes Q et R, je peux créer une colonne OIL sur ces 4 fichiers avec un liste déroulante « OUI / NON »)

• Une de mes contraintes : Ce fichier sera à disposition d’utilisateurs qui ne connaissent pas forcément Excel

Merci à vous

Bernard

Bonsoir,

Ci-joint un début de proposition, à adapter, à continuer.

La correspondance entre les données de la synthèse et chaque onglet est un parfois un peu dure à deviner

Le code VBA est assez simple, à modifier si besoin la cellule source pour chaque l'information.

Et à compléter pour les 2 autres onglets.

Pas mal de formules ne passent pas sur mon poste "=_xlfn.SWITCH(J11;"NOK";$F$4;"")", impossible de tester davantage !

Bouben

Bonjour Bouben,

Merci d'essayer de m'aider sur ce problème, j'avoue que VBA n'est pas mon fort

Pour la formule "=_xlfn.SWITCH(J11;"NOK";$F$4;"")" , je vais regardé cela , sinon sais tu me dire ou tu l'as trouvée ? ce doit etre une erreur dans mon fichier

Merci à toi

J'ai trouvé en F96 par exemple, ta formule "=_xlfn.SWITCH(J11;"NOK";$F$4;"")"

Par contre, de mon coté , je l'a voie comme "=SI.MULTIPLE(J11;"NOK";$F$4;"")", ou alors ce n'est pas en F96

J'ai retouché comme suit :

Option Explicit

Private moShS As Worksheet

Private miEcr As Integer

Public Sub Synthese()

Set moShS = Worksheets("OIL - CR DR (DR R)")

miEcr = 8

Copier "CL DR (DR)", 9, 59

Copier "CL DRE (T)", 78, 111

Copier "CL FTA (FR)", 78, 111 'ajout onglet N°3

Copier "CL BDI (BDI)", 64, 83 'ajout onglet N°4

Set moShS = Nothing

End Sub

Private Sub Copier(psOnglet As String, piLigDeb As Integer, piLigFin As Integer)

Const L_COUL_BLEU As Long = 12611584

Const S_NOK As String = "NOK"

Dim oSh As Worksheet

Dim iLig As Integer

Set oSh = Worksheets(psOnglet)

Application.ScreenUpdating = False

For iLig = piLigDeb To piLigFin

If oSh.Range("J" & iLig) = S_NOK Then

'Question N°

moShS.Range("A" & miEcr).Value = oSh.Range("A" & iLig).Value

'Type de DR

moShS.Range("B" & miEcr).Value = oSh.Range("M4").Value

'Date DR

moShS.Range("C" & miEcr).Value = oSh.Range("F3").Value

'Projet

moShS.Range("D" & miEcr).Value = oSh.Range("F2").Value

'Titre

moShS.Range("E" & miEcr).Value = oSh.Range("M2").Value 'complété avec la bonne cellule

'EDU

moShS.Range("F" & miEcr).Value = oSh.Range("F4").Value 'complété avec la bonne cellule

'Type

moShS.Range("G" & miEcr).Value = oSh.Range("M4").Value

'Évaluation des risques

moShS.Range("I" & miEcr).Value = oSh.Range("L" & iLig).Value

'Plan d'Action

moShS.Range("L" & miEcr).Value = oSh.Range("O" & iLig).Value

'Pilot Action

moShS.Range("P" & miEcr).Value = oSh.Range("S" & iLig).Value

'Criticity L - M - H

moShS.Range("Q" & miEcr).Value = oSh.Range("R" & iLig).Value

'pour Quand

moShS.Range("R" & miEcr).Value = oSh.Range("T" & iLig).Value

'Pt Fermé le

moShS.Range("S" & miEcr).Value = oSh.Range("U" & iLig).Value 'supprimé la cellule ??? pour Open/Closed

'ligne suivante

miEcr = miEcr + 1

'si ligne de titre, ajoute encore une ligne

If moShS.Range("A" & miEcr).Interior.Color = L_COUL_BLEU Then

miEcr = miEcr + 1

End If

End If

Next iLig

Application.ScreenUpdating = True

Set oSh = Nothing

End Sub

Question :

Comment maintenant je peux "copier" les info des feuilles 2 à 4 ?

Comment sur l'onglet OIL, je peux déplacer la touche violette "éditer" en A1 et la proposer en Q6 avec un texte "Editer l'OIL" ?

En tout cas, je suis déjà très content de l'aide que tu m'apportes

Je commence à espérer d'avoir enfin une solution à ma problématique

Comment sur l'onglet OIL, je peux déplacer la touche violette "éditer" en A1 et la proposer en Q6 avec un texte "Editer l'OIL" ?

J'ai trouvé : Faut juste faire un clic droit sur la case à cocher puis on peut la modifier

Reste les infos des onglets 2 , 3 et 4 à transférer

Désolé pour mes nombreux post, j'essaye d'avancer autant que je peux

Bonjour,

Bernard59178 a écrit :

J'ai trouvé en F96 par exemple, ta formule "=_xlfn.SWITCH(J11;"NOK";$F$4;"")"

Par contre, de mon coté , je l'a voie comme "=SI.MULTIPLE(J11;"NOK";$F$4;"")", ou alors ce n'est pas en F96

La fonction 'SI.MULTIPLE" est récente et n'existe pas dans ma version d'Excel, qui la traduit automatiquement, mais ne sait pas la traiter.

Pour les autres points, merci de renvoyer le fichier modifié !

Je ne suis pas sûr de pouvoir continuer avec ma version d'Excel ...

Bouben

Bonjour Bouben,

Grace à toi j'ai réussi ce que je recherchais à faire depuis plusieurs semaines

Un grand merci pour ton aide, j'ai pu en plus de modifier la macro comprendre un peu plus cet outil VBA

Je te retransmets le fichier mis à jour

Encore merci du coup de pouce, problème enfin résolu

Bonjour,

Super !

En plus d'avoir réussi à résoudre le problème, tu es désormais plus à l'aise en VBA, et c'est l'essentiel. Tu vas découvrir progressivement la puissance de la programmation

Bonne continuation !

Bouben