Recherche Texte + copie de la ligne trouvé

  • Initiateur de la discussion Guigui
  • Date de début
G

Guigui

Guest
Hello le forum,

Je rencontre plusieur petit souci avec mon projet :

J'ai 4 tableaux par feuille (defois 2 ou 5 mais bon ... bref),
J'ai 9 feuilles...
Je souhaite faire une recherche dans ces feuilles,
A chaque fois que le critere de recherche est trouvé, situé en Col A, j'aimerais que la ligne entiere soit copier et coller dans une autre feuille...
Si j'ai mes 4 tableaux le nom doit etre trouvé 4 fois et ce dans mes 9 feuilles. Donc au final, sur ma feuille 'Résumé' je dois avoir 36 lignes.
J'ai essayé un code du genre :
Code:
Cells.Find(What:='toto', After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
Ensuite, je ne sais pas comment lui faire selectioné la ligne ...
la copier ca je pense m'ensortir, la coller idem mais aprés faute faire
Code:
Cells.FindNext(After:=ActiveCell).Activate
et coller .... en dessous la 1ere ligne !! lol facil a dire...

un systeme de boucle surment mais je vois pas....
 
G

Guigui

Guest
oups, sorry, ya eu rippage de touche

Donc je continue ...

je vous joint un ti fichier d'exemple ...

Merci d'avance pour votre aide précieuse..

A+
Guillaume [file name=Recherche_copie.zip size=8861]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Recherche_copie.zip[/file]
 

Pièces jointes

  • Recherche_copie.zip
    8.7 KB · Affichages: 41

pat1545.

XLDnaute Accro
Salut,


essaie ceci meme si un peu rigide ..

Sub Copier_les_cellules_vers_F4() ' des 3 1eres feuilles vers la 4eme
Dim Plage As Range, Cell As Range, Lastrow As Integer
Dim I
For I = 1 To 3
Sheets(I).Select
Lastrow = Range('A65000').End(xlUp).Row
For Each Cell In Range('A2:A' & Lastrow)
If UCase(Cell.Value) = UCase('toto') Then
If Plage Is Nothing Then
Set Plage = Cell.EntireRow
Else: Set Plage = Union(Plage, Cell.EntireRow)
End If
End If
Next
If Not Plage Is Nothing Then
Application.ScreenUpdating = False
Plage.Copy _
Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
Set Plage = Nothing
End If
Sheets(1).Select
Next I
End Sub



Patrick
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir Patrick, Guigui, le Forum

Je me suis permis de 'désembrumer' un peu ton code, sans en changer quoique ce soit...

Cependant sur des grosses Bases de Données en Mulitifeuilles par contre je préconise la méthode 'Find'... bien plus rapide (Voir Lien supprimé (par exemple)

Sinon donc Pat, voici ton Code un petit peu Optimisé, surtout sans 'Select' qui est à éviter coûte que coûte en tant que petit conseil de base :

Option Explicit
Option Compare Text

Sub Copier_les_cellules_vers_F4_Corrected() ' des 3 1eres feuilles vers la 4eme
Dim Plage As Range, Cell As Range, Lastrow As Integer, I As Byte
   
       
For I = 1 To 3
           
With Sheets(I)
                Lastrow = .Range('A32767').End(xlUp).Row
                   
                   
For Each Cell In .Range('A2:A' & Lastrow)
                       
If Cell.Value = 'toto' Then
                           
Set Plage = Union(Cell, Cell.EntireRow)
                                Plage.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
                       
End If
                   
Next
       
           
End With
       
Next I
   
End Sub


Bonne Soirée
@+Thierry
 
G

Guigui

Guest
Hello le forum,
hello pat1545,
Hello _Thierry,

Un grand merci a vous deux pour votre aide.
J'ai recopié le module de Thierry dans ma feuille, et ca marche.

Par contre j'ai quelques questions ... lol normal ...

1/ Est-il possible de me traduire en francais:
' .Range(\\'A32767\\').End(xlUp).Row ' car je rencontre ce genre de phrase souvent mais je ni comprend rien donc peux jamais l'ajuster a mes projets... (pi si vous avez le temps, le code entier ...:) )
2/ Est-il possible de copier en plus des lignes, la case juste au dessus, cad la 'semaine X' ?
3/ comment integrer le choix des noms, je l'ai pour Toto mais pour les autres ?
4/ Thierry, pourquoi déconseils tu l'utilisation de ' Select '... j'en ai plein mes programmes... lol par quoi le remplacer ?

Euhh voila ca doit etre tous. ...

Encore un grand merci pour votre aide..

A+
Guillaume
 

pat1545.

XLDnaute Accro
Salut Thierry,

je suppose que d'éviter 'select' permet de reste toujours sur la meme feuille de départ :)) et donc de gagner un peu de temps... ?

Si oui , que faire de ce temps ? , lolllllllll , plus sérieusement est ce cela ou autre raison ? J'aimerais savoir .

Ensuite ligne 32767 ou 65536 ne change rien AMHA !


Merci de ta réponse


Pat
 

mutzik

XLDnaute Barbatruc
Bonjour Patrick, Guillaume, _Thierry

Pour ce qui concerne les explications,

1. Lastrow = .Range(\\'A32767\\').End(xlUp).Row

En faisant cela manuellement, c'est :
- se rendre en cellule A32767
- appuyer simultanément sur les touches CTRL et Flèche vers le haut (=End(xlUp))
Cette combinaison de touches permet d'atteindre la dernière cellule non vide de la col A

Dans le cas ci dessus lastrow sera égal au numéro de la dernière ligne non vide

2. Pour intégrer plus de noms, il faut initialiser une variable en tant que string et ensuite lui affecter la valeur par ex de a1

exemple : tu écris toto dans A1
dans ton code : dim NomCherche as string
NomCherche=range('A1').value

Thierry me corrigera si mistake

Pour ce qui est des autres explications, j'attend également le pourquoi du select case à éviter

Bertrand
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour Bertrand, Pat, Guigui , le Forum

Bon ça va être long ce Post, je le sens !!!

Alors je vais essayer de profiter de la mise en page pour faire clair et précis :

Lastrow = .Range('A32767').End(xlUp).Row

En effet comme Bertrand a correctement expliqué, il s’agit de partir d’une Cellule en bas de page (Ici donc La Cellule ' A32767 ') et de remonter jusqu’à la première cellule non-vide rencontrée. Et donc la Variable Integer ' LastRow ' prendra la valeur de la Ligne (Row) de cette première cellule non-vide rencontrée en partant du bas…

Pourquoi partir du Bas et pas du Haut ? Et bien pour avoir la certitude de ne pas tomber sur une cellule Vide qui se trouverait malencontreusement sur le parcours si on partait du Haut…
Si je fais tourner ceci sur un tableau comme suit :
LastRow = Range('A1').End(xlDown).Row

            Colonne A
Line 1    Toto
Line 2    Lolo
Line 3    Lulu
Line 4
Line 5    Zaza
Line 6    Titi
Line 7    Riri
Et bien LastRow sera la Ligne 3...

Pour la remarque de Pat ' Ensuite ligne 32767 ou 65536 ne change rien AMHA ! '
Queneni, en fait si j’ai mis 32767, c’est simplement parce que c’est la Limite de ma Variable LastRow qui est donc déclarée as Integer… Pour 65536, il faudrait déclarer As Long… Ce n’est pas catastrophique si on ne va jamais au-delà du remplissage de la Ligne 32767… Sinon Oui !!!!

Select / Selection à Eviter

C’est primordial sous Excel de ne pas faire de Sélection, de Feuille ou de Range, ou de Cellule tant que l’on peut l’éviter.

Et contrairement à ce que Pat a l’air de penser en disant ' donc de gagner un peu de temps... ? ' c’est vraiment beaucoup de Temps…

Vous ne me croyez pas... Démo !!!

Sub TestSelect()
Dim Cell As Range, Plage As Range
Dim Timing As Double
Timing = Timer

Set Plage = Range('A1:A5000')

   
For Each Cell In Plage
    Cell.Select
       
If Selection = '' Then Selection.Interior.Color = vbBlack
   
Next Cell

MsgBox 'Durée ' & Timer - Timing
End Sub

Sub TestSansSelect()
Dim Cell As Range, Plage As Range
Dim Timing As Double

Timing = Timer

Set Plage = Range('A1:A5000')

   
For Each Cell In Plage
       
If Cell = '' Then Cell.Interior.Color = vbBlack
   
Next Cell

MsgBox 'Durée ' & Timer - Timing
End Sub


Faites tourner les deux sur un classeur Vierge et comparer, sur la machine où je suis dans les 9 secondes pour la première macro, dans les 2 secondes pour la seconde....

Y a pas Photo !!

Par contre Bertrand, rien, mais rien à voir avec Select Case !!!!
Bon il a tellement de questions que je ne sais plus en j'en suis et je dois bosser un peu aussi !!! lol


Pour USF-Reblochon-Beta-Version-V01-01.zip et la référence manquante...

C’est sûrement le Microsoft Calendar Control 10.0… Tu as quelle Version d’Excel Pat ?, sinon c’est vraiment un mini Plus qui n’est pas important ce Calendar, tu peux supprimer pûrement et simplement le UserForm3… Et dans le Code du UserForm2 tu supprimes ceci :

Private Sub LblDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
UserForm3.Show
End Sub


Copier en plus des lignes, la case juste au dessus, cad la 'semaine X' ?

Je t'avoue ne pas saisis ce que tu dis par là Guigui ? Semaine X vient d'où ? Et tu le veux Où ? Au dessus de chaque ligne retournée avec une occurrence trouvée sur 'Toto'... car pour moi ce n'est pas du clair ce que tu souhaites faire...


Comment integrer le choix des noms, je l'ai pour Toto mais pour les autres ?

En fait Bertrand répond très bien pour récupérer ton nom dans une Cellule, et si tu veux une InputBox alors voici comment je ferai :

Option Explicit
Option Compare Text

Sub Copier_les_cellules_vers_F4_Corrected() ' des 3 1eres feuilles vers la 4eme
Dim Plage As Range, Cell As Range, Lastrow As Integer, I As Byte
Dim SearchedString As String

SearchedString = InputBox('Veuillez Indiquer le Mot recherché', 'Recherche', 'Toto')
If SearchedString = '' Then Exit Sub


   
For I = 1 To 3
       
With Sheets(I)
            Lastrow = .Range('A32767').End(xlUp).Row

               
               
For Each Cell In .Range('A2:A' & Lastrow)
                   
If Cell.Value = SearchedString Then
                       
Set Plage = Union(Cell, Cell.EntireRow)
                       
                        Plage.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
                   
End If
               
Next
   
       
End With
   
Next I
   
End Sub

Voilà en espérant ne pas avoir Zappé des points, sinon vous me le direz !!!!

Bonne Journée
@+Thierry
 
G

Guigui

Guest
Hello à tous,

Thierry et Bertrand, un grand merci pour vos explications.... je saisie mieux les code maintenant.

Thierry, pour mon choix de nom, je m'était lancé dans ceci :
Code:
Sub Copier_les_cellules_vers_F4_Corrected() ' des 3 1eres feuilles vers la 4eme
Dim Plage As Range, Cell As Range, Lastrow As Integer, I As Byte, C As Variant
    C = UserForm1.ComboBox1.Value
        For I = 5 To 13
            With Sheets(I)
                Lastrow = .Range('A32767').End(xlUp).Row
                    
                    For Each Cell In .Range('A2:A' & Lastrow)
                        If Cell.Value = C Then
                            Set Plage = Union(Cell, Cell.EntireRow)
                                Plage.Copy Destination:=Sheets(2).Range('A65536').End(xlUp)(2)
                        End If
                    Next
        
            End With
        Next I
    
End Sub
Qui à ma grande surprise ... fonctionne !! bon bref ... lol

Pour ce qui est de mon probleme de 'Semaine X'

Je te rejoint mon fichier exemple pour que tu saisisses, en clair je veut 'emener' avec ma EntireRow... la ligne ou est écrit la semaine... bon.. euh regarde la piece jointe...

Peux tu me 'traduire' la ligne : Set Plage = Union(Cell, Cell.EntireRow), et à quoi correspond le (2) dans '...End(xlUp)(2)'

Je pose beacoup de question... mais c'est pour comprendre ce qu'on me transmet en aide... c'est mieux pour réutiliser certaine choses...

Merci d'avance pour tes (vos) réponses.

A+
Guillaume
 

mutzik

XLDnaute Barbatruc
Bonjour le fil, le forum, le fort homme (c'est pour Thierry)

end(xlUp) fait remonter a la dernière cellule non vide. Cela tu l'avais compris. Pour excel, cette cellule porte l'indice (1) maintenant

(xlUp)(2) se rend donc une ligne en-dessous de celle selectionnée et y copie les data. Essaie en mettant (3), tu verras le résultat

Concernant union, cette instruction fait l'union entre deux ranges pour les copier, les effacer, les remplir ...

Dans le cas qui nous occupe, cela n'est pas forcément nécessaire. Le code ci-dessous fonctionne très bien aussi

Set Plage = Cell.EntireRow

Thierry, tu me tires les oreilles si je raconte des bétises (je préfère celles de Cambrai)

Amitiés
Bertrand
 

mutzik

XLDnaute Barbatruc
Re Guillaume,

Pour copier ton nr de seamine, mets le code suivant

If Cell.Value = SearchedString Then
Set semaine = Cell.Offset(-1, 0)
semaine.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)

Set Plage = Cell.EntireRow
Plage.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
End If

et ca marche
PS : n'oublie pas de déclarer la variable semaine as range en début de code

a+
Bertrand
 
G

Guigui

Guest
Hello a tous, mutzik,

Merci pour ton aide

je voulais savoir ou je dois placer ton code dans celui de thierry ?

Autre question,
Pour me familiarisé avec le code Range('a65536').End(xlUp)(2)
je fais des ptits test....

je veut dans la cells A1 écrire 'TOTO' puis quand je recommence le sub (sans boucle) je veut 'TOTO' mais en A2 :

j'encode ca comme ceci :

Code:
Sub Macro1()
Range('A100').End(xlUp).Value = 'toto'
End sub

mais ca ne fais rien !!!!!
Peux tu me dire ou je me plante ??
pfff moi qui croyait avoir compris ....

Merci d'avance
A+
Guillaume
 
G

Guigui

Guest
Re...

Alors en bidouillant j'ai un resultat avec
Code:
Sub Macro1()
Range('A100').End(xlUp).Cells.Offset(1, 0).Value = 'TOTO'
End Sub

Est-ce que c une sale écriture ?
Est-ce la solution ?

A+
Guillaume
 

Discussions similaires