XL 2010 [Résolu] Copier/Coller ligne avec conditions et récurrences

[Saxophone]

Bonjour à toutes et tous
Je n'ai pas trouvé de solution sur le forum répondant spécifiquement à un cas comme celui-ci...
Je vous explique la situation :
La colonne A contient un numéro de demande.
Pour chaque numéro de demande, les colonnes B, C et D de la même ligne peuvent contenir des données si l'utilisateur les a remplies.

On a donc par exemple 2 numéros de demande "1" et "2" et des données inscrites par l'utilisateur

A B C D
1 x y z
2 u v

Et dans un autre onglet je souhaiterai que la macro qui s'exécute donne :

A B C D
1 x
1 y
1 z
2 u
2 v

Je le traduirai comme ceci à l'écrit :
Pour chaque numéro de commande de la colonne A :
Si le contenu de la cellule B2 <> "" alors on copie dans l'autre onglet le contenu de A2 et B2
Si le contenu de la cellule C2 <> "" alors on copie dans l'autre onglet le contenu de A2 et C2
Si le contenu de la cellule D2 <> "" alors on copie dans l'autre onglet le contenu de A2 et D2

Je ne vois pas comment gérer la chose en VBA, étant pas bon pour créer des codes et je n'ai rien trouvé correspondant à ça sur internet ou bien je n'ai pas su l'adapter.

Merci beaucoup de votre aide.

 

[Modeste]

Bonjour Saxophone, JM et ceux qui passeront par ici

C'est vrai que l'exemple est tellement "anonymisé" que la logique échappe à ceux qui "débarquent" dans le fichier.
On ne sait toujours pas (toi oui, certainement!) comment identifier les colonnes ciblées:

• il n'y en aura que 3?
• ce seront toujours les colonnes B, D et F?
• il s'agit de toutes les colonnes (peu importent leur nom et leur position) dont le titre commence par "Data user"?
• idem pour les colonnes "Choix": toujours 2? Jamais plus? Toujours en colonnes C et E? Jamais de cellules vides?
• si pour une demande, il n'y a pas de Data User 2, il ne saurait pas y avoir de Data User 3 et on peut passer à la demande suivante?

 

[Staple1600]

Bonjour à tous, salut Modeste

Avec cette macro, j'obtiens le résultat attendu, non ?
(C'est le cas sur le fichier exemple du fil - message #9)

Sub b()
Dim L&, i&, Q&, ZZ&
L = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To L
Q = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row
ZZ = Application.CountA(Cells(i, "B"), Cells(i, "D"), Cells(i, "F"))
Feuil2.Cells(Q + 1, 1).Resize(ZZ).Value = Cells(i, 1).Value
Feuil2.Cells(Q + 1, 2).Resize(ZZ).Value = Application.Transpose(Array(Cells(i, 2).Text, Cells(i, 4).Text, Cells(i, 6).Text))
Feuil2.Cells(Q + 1, 3).Resize(ZZ) = Cells(i, 3)
Feuil2.Cells(Q + 1, 4).Resize(ZZ) = Cells(i, 5)
Q = Q + 1
Next
End Sub

Avant de tester, mettre en commentaire (ou supprimer) le code VBA présent dans le code de la Feuille 2.
NB: Cette dernière macro est à mettre un module standard.
La macro doit être exécutée quand c'est la Feuille1 qui est active.

 

[Saxophone]

Bonjour à tous,
Ci-joint dans les onglets Source et Résultat vous trouverez le vrai format attendu pour chaque (avec les colonnes et lignes de départ etc). Le fichier source peut contenir au maximum je dirai 200 lignes de demande, je ne sais pas si cela à son importance.
Les couleurs et les formes correspondaient à des Dates et Heures. J'espère que ce sera plus parlant, j'avoue y avoir été un peu fort au niveau "anonymisation"... ).
L'onglet contenant le tableau résultat à pour objectif d'être exporter au format .csv avec ";".
J'aurai dû être plus clair dès le départ, veuillez m'en excuser.

 

[Staple1600]

Re à tous

Saxophone
Tu as zappé ma macro de mon précédent message, non ?

 

[Saxophone]

Re,
Tu as posté juste avant moi effectivement.
Je viens de tester ton code, il fonctionne sur l'exemple dans le fichier ! Merci.
Par contre dans le cas où le "départ des données" n'est pas le même (cas du fichier "Illustration Besoin Amélioré") entre les deux onglets, je n'arrive pas à adapter ton code.
Dans l'onglet Source, le début est en B7 et dans l'onglet Résultat en A2.
J'ai modifié les colonnes ciblées, appelées maintenant M, O et Q.
J'ai modifié le numéro de début de ligne : 7 pour i.
En éxécutant, il me fluote la ligne

Feuil2.Cells(Q + 1, 1).Resize(ZZ).Value = Cells(i, 1).Value

En disant, Erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet

Sub b()
Dim L&, i&, Q&, ZZ&
L = Range("B" & Rows.Count).End(xlUp).Row
For i = 7 To L
Q = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row
ZZ = Application.CountA(Cells(i, "M"), Cells(i, "O"), Cells(i, "Q"))
Feuil2.Cells(Q + 1, 1).Resize(ZZ).Value = Cells(i, 1).Value
Feuil2.Cells(Q + 1, 2).Resize(ZZ).Value = Application.Transpose(Array(Cells(i, 2).Text, Cells(i, 4).Text, Cells(i, 6).Text))
Feuil2.Cells(Q + 1, 3).Resize(ZZ) = Cells(i, 3)
Feuil2.Cells(Q + 1, 4).Resize(ZZ) = Cells(i, 5)
Q = Q + 1
Next
End Sub

 

[Staple1600]

Re

Ma macro fonctionne sur le fichier exemple fourni au départ.
Donc mission remplie.
Maintenant, en plein dimanche, tu postes un dernier fichier exemple tout différent!
Comme dirait Lucette: "Ça chie dans la colle, mon brave!)
En guise de pénitence, je te laisse te débrouiller en solo
Le temps pour moi de vaquer à quelques tâches ménagères ou autres joyeusetés dominicales.
Je reviendrai plus tard.... ou pas (selon l'envie du moment)

EDITION: Un petit indice néanmoins
M'est avis que Feuil2 ne correspond pas à la feuille Résultat qui serait plutôt la Feuil4
Sans oublier le cas la feuille Source qui...

 

[Staple1600]

Re à tous

Saxophone
Suis tombé par harsard la dessus

Du coup me v'là en good mood, donc obligé de lever la pénitence
Donc voici la macro modifiée pour fonctionner avec ton dernier fichier

Sub c()
Dim L&, i&, Q&, ZZ&
L = Range("B" & Rows.Count).End(xlUp).Row
For i = 7 To L
Q = Feuil4.Cells(Rows.Count, 1).End(xlUp).Row
ZZ = Application.CountA(Cells(i, "M"), Cells(i, "O"), Cells(i, "Q"))
Feuil4.Cells(Q + 1, 1).Resize(ZZ).Value = Cells(i, 2).Value
Feuil4.Cells(Q + 1, 4).Resize(ZZ).Value = Application.Transpose(Array(Cells(i, "M").Text, Cells(i, "O").Text, Cells(i, "Q").Text))
Feuil4.Cells(Q + 1, 6).Resize(ZZ) = Cells(i, 5)
Feuil4.Cells(Q + 1, 7).Resize(ZZ) = Cells(i, 6)
Feuil4.Cells(Q + 1, 8).Resize(ZZ) = Cells(i, 7)
Feuil4.Cells(Q + 1, 9).Resize(ZZ) = Cells(i, 8)
Q = Q + 1
Next
End Sub

 

[Modeste]

Re,

Dis JM, si tu viens nous mettre Eileen au milieu du jeu de quilles, on va pas s'en sortir

Je m'étais attaqué à du repassage, pendant que Staple1600 répondait ...

Pour autant que j'aie compris (et que je ne me sois trompé nulle part), voici mon code mis à jour (cette version utilise des tableaux en mémoire)

Private Sub Worksheet_Activate()

[A2].Resize([A1].CurrentRegion.Rows.Count, 4).ClearContents
With Feuil3
tablo = .Cells(7, 2).Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 1, 16)
Dim tabres()
For i = 1 To UBound(tablo)
  For col = 12 To 16 Step 2
  If tablo(i, col) <> "" Then
  ReDim Preserve tabres(8, X)
  tabres(0, X) = tablo(i, 1)
  tabres(3, X) = tablo(i, col)
  tabres(5, X) = tablo(i, 4)
  tabres(6, X) = tablo(i, 5)
  tabres(7, X) = tablo(i, 6)
  tabres(8, X) = tablo(i, 7)
  X = X + 1
  Else
  Exit For
  End If
  Next col
Next i
End With
[A2].Resize(X, 9) = Application.Transpose(tabres)
End Sub

 

[Saxophone]

Re Staple1600,
Je m'étais penché sur ton code, j'avais réussi à l'adapter ! sévir ça a dû bon aussi
Grâce à toi j'ai pu comprendre le code à peu près, je l'ai commenté :
(d'ailleurs j'ai dû renommer la macro, le fait que la Sub s'appelle "c" ne me permettait pas de la lancer Oo)

Sub ddddd()
Dim L&, i&, Q&, ZZ&
'défini le nombre de ligne de la colonne B du tableau source à traiter
L = Range("B" & Rows.Count).End(xlUp).Row
'si on veut commencer à la ligne 7 du fichier source, mettre i=7, afin de ne pas prendre en compte les en têtes
For i = 7 To L
Q = Feuil4.Cells(Rows.Count, 1).End(xlUp).Row
'définir les colonnes à traiter, correspondant aux Data User, ici M, O et Q.
ZZ = Application.CountA(Cells(i, "M"), Cells(i, "O"), Cells(i, "Q"))
'ligne qui s'occupe des numéros de demande, elle va mettre le numéro de demande dans la première colonne de la feuil2
Feuil4.Cells(Q + 1, 1).Resize(ZZ).Value = Cells(i, 2).Value
'ligne qui s'occupe des données dans les colonnes Data User. Si la colonne résultat est "D", mettre (Q+1,4)
'Changer le "2" de Array(Cells(i, 2) par 13, 15 et 17 selon les colonnes choisies plus haut pour Data User Feuil 1 ou mettre les lettres
Feuil4.Cells(Q + 1, 4).Resize(ZZ).Value = Application.Transpose(Array(Cells(i, "M").Text, Cells(i, "O").Text, Cells(i, "Q").Text))
'ligne qui s'occupe de la colonne Date début
'(Q+1,3) correspond à la donnée destination, colonne 3 --> cells(i,3) correspond à la donnée source, colonne 3
'modifier donc chaque fois l'indice de la colonne selon les colonnes souhaitées
Feuil4.Cells(Q + 1, 6).Resize(ZZ) = Cells(i, 5)
Feuil4.Cells(Q + 1, 7).Resize(ZZ) = Cells(i, 6)
Feuil4.Cells(Q + 1, 8).Resize(ZZ) = Cells(i, 7)
Feuil4.Cells(Q + 1, 9).Resize(ZZ) = Cells(i, 8)
Q = Q + 1
Next
End Sub

Le hic, c'est qu'il y a une cellule dans "User data" qui est vide pour la demande n°3. La macro copie les dates et heures alors qu'il n'y a pas de donnée dans User Data 3 du fichier source pour la demande n°3. Dans le fichier joint j'ai rempli en jaune la cellule concernée dans l'onglet résultat.
Aussi le format des dates et heures se transforme Oo, peut-on le laisser en texte afin qu'il ne change pas ? (en vue de l'extraction en .csv) via un pastespecial ou autre peut etre ?

Merci beaucoup pour ton aide en tout cas !

EDIT : Ah Modeste tu viens juste de poster avant moi ^^

 

[Saxophone]

Ton code Modeste fonctionne parfaitement. Il garde même le format de la data en "jj/mm/aaaa" mais pas celui de l'heure Oo comment ça se fait ? est-il possible d'avoir le même résultat pour l'heure ? en format "hh:mm" ?

Merci encore !
(pour ma part les tâches ménagères c'était hier ^^)

 

[Staple1600]

Re à tous

Modeste
Allez, come on . t'aimes pas Eileen?

Saxophone
Ou est le problème avec la demande N°3 ?
Copie d'écran du résultat de ma dernière macro

 

[Saxophone]

Voici ce que j'obtiens avec la macro Staple1600.
D'ailleurs, les dates et heures ne changent pas pour toi ? Oo

 

[Staple1600]

Re à tous

Non, le résultat est celui de la copie d'écran (sauf le coloriage en jaune)
•Tu lances bien la macro quand c'est la feuille Source qui est active ?
•Il n'y aucun code VBA dans la feuille Résultat ?
•La macro est bien dans un module standard ?

NB: Ces trois points étaient pourtant spécifiés dans messages précédents.

 

[Modeste]

Re²,

Z'êtes durs à suivre, les jeunes ... faut que je pédale avec mes petites jambes

Les résultats qui surprennent Saxophone avec le code de Staple1600 ne contiendraient-ils pas des données issues des précédentes exécutions?

Pour ce qui concerne mon code et les formats dates et heures, le plus simple serait sans doute d'appliquer le format en question à une plage suffisamment étendue? Il ne faudra le faire qu'une fois, puisque la première instruction n'efface que les contenus.
Attention: dans cette première instruction, ne pas oublier de modifier le nombre de colonnes (9 au lieu de 4) pour s'adapter au dernier fichier.

 

[Saxophone]

Re à tous,
Staple1600, j'ai encore le même résultat que sur ma capture d'écran (voir fichier joint). J'ai appliqué texto ce que tu as posté et j'ai bien tout recommencé dans un nouveau fichier.

Modeste, que veux-tu dire par appliquer le format à une plage suffisamment étendue ? via format de cellule ?
Le problème c'est que lors de l'extraction en .csv, les données seront en décimales pour les heures (les dates ça fonctionne je ne sais pas trop pourquoi), or j'aimerai qu'elles restent en tant que ;hh:mm;
Dans le fichier "Code Modeste" j'ai rajouté un module que j'ai trouvé sur le net permettant d'exporter en .csv. Le problème du format des heures est ma dernière épine dans le pied..