Recherche val, cut, coll autre cell Résolu/Fermé

Question

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.

Mike-31 · Answer

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+

Gorion87 · Answer

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

Mike-31 · Answer

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+

Gorion87 · Answer

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

Mike-31 · Answer

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+

Gorion87 · Answer

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

Mike-31 · Answer

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+

Gorion87 · Answer

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

Gorion87 · Answer

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 ?

Mike-31 · Answer

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+

Gorion87 · Answer

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 !!!

Mike-31 · Answer

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+

Gorion87 · Answer

Merci beaucoup !!
Ca apporte quoi en fait par rapport à la précedente ?

Gorion87 · Answer

OK merci ca marche impec !!!
je vais pouvoir bien avancer sur mon tableau de bord maintenant :-)
Bonne journée et encore merci

Recherche val, cut, coll autre cell

14 réponses

Discussions similaires