Recherche val, cut, coll autre cell

Résolu/Fermé
Gorion87 - 20 févr. 2009 à 12:30
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 - 25 févr. 2009 à 09:55
Bonjour à tous

Apres d’âpres recherches sur tout les forums et divers essais non concluant depuis 3 jours, j’en arrive à avoir besoin de votre aide pour réaliser la macro que je souhaiterai avoir. Ceci est dans le cadre de mon travail et c'est assez urgent.

Voici le problème :

Ex de tableau excel

	    A	 B	C	  D	        E		 F	         G
Ligne 1	000001	RN	2	EUR	19/02/2009	PG:	3 475 052.770
Ligne 2	Client X				19/02/2009	PN:	270 983.020
Ligne 3
Ligne 4
Ligne 5	000002	RN	6	EUR	19/02/2009	PG:	204 083.330
Ligne 6 	Client Y		          	19/02/2009	PN:	204 083.330
Ligne 7 
Ligne 8
Ligne 9	000003	RN	9	AUD	19/02/2009	PG:	318 008.850
Ligne 10	Client Z			          19/02/2009     	PN:	26 342.860
Ligne 11
Ligne 12		RN	13	EUR	19/02/2009	PG:	952 388.890
Ligne 13					 19/02/2009	PN:	78 807.740
Ligne 14
Ligne 15		RN	14	USD	19/02/2009	PG:	3 384 166.670
Ligne 16					19/02/2009	PN:	280 032.710


Donc je voudrais que la macro recherche la valeur “PN:” dans la colonne F, coupe la ligne trouvée de la colonne A à G et la colle sur la ligne au-dessus dans la colonne H. Ceci afin d’avoir une seule ligne de données au lieu de deux et ceci pour toutes lignes avec "PN:". Et que par la suite les lignes vides soient effacées.

Pour au final avoir ceci comme tableau :

	A       B  C   D          E	     F            G           H         I       J     K
Ligne 1  000001  RN 2  EUR   19/02/2009  PG:  3 475 052.770   Client X  19/02/2009  PN:  270 983.020
Ligne 2  000002  RN 6  EUR   19/02/2009  PG:     204 083.330  Client Y  19/02/2009  PN:   204 083.30
Ligne 3  000003  RN 9  AUD   19/02/2009  PG:     318 008.850  Client Z  19/02/2009  PN:    26 342.860
Ligne 4          RN 13 EUR   19/02/2009  PG:     952 388.890            19/02/2009  PN:     78 807.740
Ligne 5	        RN 14 USD   19/02/2009  PG:   3 384 166.670            19/02/2009  PN:   280 032.710

Merci d’avance pour votre aide.
A voir également:

14 réponses

Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
22 févr. 2009 à 15:45
Salut,

Récupéres le fichier avec le lien ci-dessous voir si c'est ce que tu cherches

https://www.cjoint.com/?cypRsGC1a4

Si c'est le résultat attendu, joints un exemple de ton fichier dans un prochain post pour adapter ou écrire le code différemment

avec ce lien

https://www.cjoint.com/

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
23 févr. 2009 à 09:33
Bonjour,

C'est exactement ce que je recherche !!!! Excellent !!!!

Pourrais-tu me donner la macro associée stp ???

Je pense qu'il n'y a aucune modif à y apporter hors mis le fait que les 5 premières lignes ne devraient pas être supprimées mais ca je pense que ce n'est qu'un détail :-)

Merci encore
0
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
23 févr. 2009 à 10:23
Salut Gorion87,

Comme je te l'ai dit avec un exemple de ton fichier ou connaissant tes entêtes de colonnes il serait préférable de faire tourner la macro de bas en haut, ce qui éviterait la suppression des lignes et de nommer la cellule FIN pour arrêter le code, sinon la macro descend jusqu'en bas de la feuille excel. Dés que j’ai un moment je t’écris ce code

Pour l’instant, j’ai modifié le code pour éviter le blocage dans le cas d'utilisation alors que les lignes sont déjà regroupées.

Si le fichier doit évoluer je pense que le résultat doit être déplacé sur une autre plage voir feuille sinon la suppression des colonnes ne sera pris en charge qu'une fois

Sub Regroupement()
On Error GoTo Erratum
Dim c
Range("F1").Select
Do While ActiveCell <> "PN:"
ActiveCell.Offset(1, 0).Select
If ActiveCell = "PN:" Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, -5)).Cut
ActiveCell.Offset(-1, 2).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -2).Select
End If
If ActiveCell = "FIN" Then
Range("F1:FIN").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For c = 25 To 1 Step -1
If Cells(100, c).End(xlUp).Row = 1 Then Cells(1, c).EntireColumn.Delete
Next c
Range("F1").Select
Erratum: Exit Sub
Exit Sub
End If
Loop
Application.CutCopyMode = False
End Sub

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
23 févr. 2009 à 10:43
Merci pour le code.

En fait l'utilisation de la macro s'effectue dans le cadre d'une copie écran d'un logiciel sans extraction possible sous Excel. Donc au final, je fais un copier / coller à partir du logiciel et je le colle sous Excel, ce qui veut dire qu'à chaque fois que je le colle, le format reprend sa base initiale issue du logiciel (colonne vide...). Pour le regroupement des lignes enfin de comptes, je pense que ca ne posera pas de pb vu quelles seront à nouveau séparée lors du nouveau collage...Je sais pas si c'est très clair :-)

Pour le fait de commencer de bas en haut, je pense que ce serait effectivement plus adapté à l'utilisation de cette macro, pour éviter de mettre le mot "FIN". Et je n'ai pas d'en-tête sur ce fichier mais sur celui de destination finale qui est Access.

J'attend avec impatience ton nouveau code, pour me permettre de poursuivre mais ca m'a déjà beaucoup aidé !!

Encore merci
0

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

Posez votre question
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
23 févr. 2009 à 10:54
Re,

Oui c'est clair, donc le code va bien.

Pour le code de bas en haut, si tu n'as pas d'en tête, le problème est le même il faudra mettre un mot reconnu par le code pour l'arrêter.
Soit tu crées effectivement des en-têtes et tu colles tes informations au dessous dans ce cas on intégre le nom d'un en tête dans le code ou on laisse le mot FIN dans le code et tu le sasis en en-tête de ta colonne ou on laisse le code comme cela et tu saisis FIN sous ta dernière ligne

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
23 févr. 2009 à 11:17
C'est bon je l'ai testé ca tourne impec !!!
Je crois que je vais faire des en-tetes se sera plus simple d'utilisation au lieu de mettre "FIN" à chaque fois en dessous de la colonne !! Dans ce cas là j'ai juste à changer le mot "FIN" par le nom de l'en-tête mais ai-je d'autres modif à faire ? Comme maintenant ca partirait du bas vers le haut...

Et j'ai un dernier soucis, ca ne me supprime pas les colonnes vides et les lignes vides !!!
J'ai essayé de le faire en enregistrement de macro et je l'ai mis à la suite de celle-ci mais apparement elles ne sont pas prise en compte !!!!

Macro :

On Error GoTo Erratum
Dim c
Range("G1").Select
Do While ActiveCell <> "PN:"
ActiveCell.Offset(1, 0).Select
If ActiveCell = "PN:" Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, -6)).Cut
ActiveCell.Offset(-1, 2).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -2).Select
End If
If ActiveCell = "FIN" Then
Range("G1:FIN").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For c = 25 To 1 Step -1
If Cells(100, c).End(xlUp).Row = 1 Then Cells(1, c).EntireColumn.Delete
Next c
Range("G1").Select
Erratum: Exit Sub
Exit Sub
End If
Loop
Application.CutCopyMode = False
" La macro s'arrete ici mais sans bugger "
ActiveWindow.SmallScroll ToRight:=-4
Range("G:G,J:O").Select
Range("J1").Activate
Selection.Delete Shift:=xlToLeft
Range("F1").Select

Range("A5:A2000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


Merci
0
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
23 févr. 2009 à 11:24
Tout dépend de la struture de tes données, si tu reprends mon exemple avec des saisies de la colonne A à G et que tu mettes FIN en F il n'y a pas de raison.

Pour faire marcher le code de bas en haut il faut le réécrire différemment.

Le plus simple comme je te l'ai déjà dit mets un exemple concret sur un post ce sera plus facile pour tous, avec ce lien

https://www.cjoint.com/

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
23 févr. 2009 à 11:46
Voici le lien avec l'exemple du tableau :

https://www.cjoint.com/?czlSCkpGlr

En feuille 2 j'ai mis le resultat souhaité avec la suppression de la colonne G et celles de J à O,
ainsi que les lignes vides.

Merci
0
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
23 févr. 2009 à 13:20
Re,

les boutons Action sur tes feuilles servent ils a quelque chose ou puis je m'en servir pour lancer le code !!!

Dans le code il est possible d'intégrer le déplacement des données une fois traitées vers la feuille regroupement souhaité par exemple !!!

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
23 févr. 2009 à 13:52
Oui oui tu peux l'utiliser, je lai laissé exprès pour !!!
Se sera le bouton final qui regroupera les macros !!!
Je sais quil est possible d'importer sous Access les données d'une feuille Excel mais je ne sais pas si c'est possible d'intégrer dans la macro le fait d'exporter les données vers le tableur de base de données Access ?
0
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
23 févr. 2009 à 18:22
Re

Récupères le fichier avec le lien ci-dessous.

La macro s'éxécute tant que Date n'est pas trouvé dans l'en-tête de la colonne F

Déplacement vers la droite des lignes PN:

Suppression des lignes vides et des colonnes inutiles

déplacement sur la feuille regroupement souhaité des nouvelles données

Il est possible d'intégrer l'enregistrement, insérer la colonne G qui à été supprimée etc ...

https://www.cjoint.com/?czsma7rUNd

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
24 févr. 2009 à 12:18
Franchement je ne sais pas comment te remercier c'est vraiment génial !!!
Tu m'as permis de réaliser ce que je voulais faire encore un grand merci !!!
Je découvre ce forum et la communauté et toute cette entre-aide ca fait plaisir
dans ce monde si individualiste :-)

Encore merci !!!
0
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
24 févr. 2009 à 13:29
Salut,

Colles plutôt ce code pour éviter les blocages dans le cas d'utilisation anormale, après les apostrophes des infos pour t'y retrouver

Sub Regroupement_Transfert()
On Error GoTo Erratum
Dim LigFin As Long
Col = "G"
LigFin = Range("G100").End(xlUp).Select 'Sélectionne la première cellule non vide
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.Offset(0, -1) <> "Date" 'Le code s'éxécute tant que Date n'est pas rencontré dans la cellule décalée
ActiveCell.Offset(-1, 0).Select
If ActiveCell = "PN:" Then 'Si PN: est rencontré
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, -6)).Cut 'Edition Couper
ActiveCell.Offset(-1, 2).Select 'Cellule active se décale 1 ligne vers le haut et de 2 vers la droite
ActiveSheet.Paste 'Edition coller
ActiveCell.Offset(0, -2).Select 'La cellule revient dans la colonne G
End If
Loop
If ActiveCell.Offset(0, -1) = "Date" Then 'Fin du bouclage

'Suppression des lignes vides
LigFin = Range("A100").End(xlUp).Select 'Sélectionne la première ligne non vide
Range(ActiveCell, Range("P6")).Select 'Sélectionne la plage à traiter
Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 'supprime les lignes vides

'Sélectionne les colonnes à supprimer
Range("G:G,J:O").Delete Shift:=xlToLeft 'Supprime les colonnes

'Sélectionne le tableau à exporter
LigFin = Range("A100").End(xlUp).Select
Range(ActiveCell, Range("I6")).Cut 'Edition Couper
'Déplacement des données
Sheets("Regroupement souhaité").Select 'Active la feuille Regroupement Souhaité
LigFin = Range("A100").End(xlUp).Select 'Recherche la première ligne vide
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste 'Edition Coller
Range("A4").Select

Sheets("Regroupement").Select
Columns("G:G").Select
Selection.Insert Shift:=xlToRight

Range("A4").Select
End If
'ActiveWorkbook.Save 'Supprimer l'apostrophe pour un enregistrement automatique
Erratum: Exit Sub
Exit Sub
Application.CutCopyMode = False
End Sub


A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
24 févr. 2009 à 13:54
Merci beaucoup !!
Ca apporte quoi en fait par rapport à la précedente ?
0
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 5 076
24 févr. 2009 à 14:57
le code est le même à part que j'ai rajouté une ligne en début et fin de procédure pour éviter que le code bloque la macro dans le cas d'erreur lorsque tu activerais la macro sur une feuille vide ou que tu aurais déjà activé le code. cela t'évitera de fermer excel pour le débloquer ou ouvrir le visual basic pour le réinitialiser

On Error GoTo Erratum


Erratum: Exit Sub

A+
0
Gorion87 Messages postés 55 Date d'inscription vendredi 20 février 2009 Statut Membre Dernière intervention 28 février 2011 19
25 févr. 2009 à 09:55
OK merci ca marche impec !!!
je vais pouvoir bien avancer sur mon tableau de bord maintenant :-)
Bonne journée et encore merci
0