Procédure avec Find

Résolu
Bonjour,

En plein apprentissage, j'ai réussi en m'inspirant voir en copiant des morceaux de codes

(Merci à tous ceux qui ont eu la gentillesse de laisser ces codes sur les différents sites)

et en me servant de la formation VBA, à créer une petite procédure qui va me permettre de rassembler des données de deux feuilles excel sur une troisième.
Le premier problème qui était de trouver les cellules à été réglé avec FIND mais je n'arrive pas à entourer la procédure d'une boucle pour la faire tourner.
Est ce que quelqu'un peut m'aider?
Je voudrais que cette procédure puisse tourner sur une trentaine de noms.
celui utilisé ci-dessous est "papa"
Je vous mets ce que j'ai pour l'instant

Dim papa As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
Valeur_Cherchee = "papa"
Set PlageDeRecherche = Range("C6:G23")
Set papa = PlageDeRecherche.Cells.Find(What:=Valeur_Cherchee, LookAt:=xlWhole)
If papa Is Nothing Then
MsgBox Valeur_Cherchee & " n'est pas présent dans la plage " & PlageDeRecherche.Address
Exit Sub
Else
AdresseTrouvee = papa.Address
End If
Range(AdresseTrouvee).Activate
Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 5).Select
Selection.Copy
Worksheets("Feuil1").Select
Cells.Find(What:="papa", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole).Activate
ActiveSheet.Paste
Worksheets("Feuil2").Select
Application.CutCopyMode = False
Range("A1").Activate


Merci d'avance à ceux qui se pencheront sur ce petit problème.

14 réponses

  1. Contributeur
    Bonjour Luky Luke

    "papa" se trouve t il sur une seule colonne (colonne C par ex) ou n'importe où dans C6:G23 ?

    feuille de recherche: feuille1 ?
    feuille de restitution: feuille2 ? cellule de départ (A2 ?) de la restitution des lignes avec "papa" ?

    -----
    Signé Joe Dalton
    0
    1. Bonjour Michel,

      Merci pour la réponse rapide, je crois que je me suis emballé un p'tit peu, je vais essayer de vous donner tous les éléments.

      - j'ai un classeur 1\feuille 1\tableau 1 avec dans la colonne B, les noms (env 30). les noms ne se suivent pas ligne par ligne (ex : papa en B5, mimi en B7, momo en B10, etc...
      Sur la ligne de chaque nom, environ 60 cellules à copier (ex: pour papa, C5, D5, E5 etc....)

      - j'ai un autre classeur 2\feuille 1\tableau 1 avec la même chose mais des noms différent du premier tableau et avec l'ordre des noms qui change, également, en face, 60 cellules à copier

      -Je veux coller chaque lot de cellule copié par nom dans un troisième classeur 3 \feuille 1\tableau 1 en face du même nom. Dans ce dernier tableau, les noms sont dans l'ordre alphabétique et aussi décalés (B5, B7, B9, etc...)

      Dans l'idéal : la procédure se trouve sur mon troisième tableau

      - j'ouvre classeur 1 \ feuille 1 (tableau 1)
      - j'ouvre classeur 2 \ feuille 1 (tableau 1)
      - Je copie les données du classeur 1 et je les colle dans le classeur 3 \ feuille 1 tableau 1
      - Je copie les données du classeur 2 et je les colle dans le classeur 3 \ feuille 1 tableau 1
      - je fais la même chose pour les six onglets suivants
      - je ferme sans enregistrer le tableau 1
      - je ferme sans enregistrer le tableau 2

      J'espère avoir bien expliqué mon problème, j'ai quand même l'impression de vouloir créer une usine à gaz.
      Merci pour votre soutien et du temps que vous m'accorder.

      Cowboy56
      0
      1. Contributeur
        bonjour,
        pour s'en sortir:
        mettre un extrait de tes 3 classeurs (et non un exemple vite fait mal fait) zippés ensemble sans données confidentielles en pièce jointe sur
        https://www.cjoint.com/
        puis copier l'adresse du lien et la coller dans le message de réponse
        0
    2. Bonjour cowboy56

      As-tu fait "tourner" ta macro , pas par pas (avec F8)?
      0
      1. Bonjour,

        Oui l'ébauche marche bien mais je ne travaille que sur 2 tableaux, il faut étendre sur trois et ensuite sur les onglets, la tache me semble insurmontable.

        Merci
        0
        1. Modérateur
          Bonjour cowboy56,
          Salut Michel,

          Excusez l'incruste, je ne fais que passer.
          Juste pour signaler à cowboy la fonction personnalisée FindAll qui retourne une variable tableau contenant les lignes ou l'on trouve le mot cherché...

          Bonne continuation
          0
          1. Contributeur
            Salut Frank

            je ne connaissais pas Findall, merci. j'étudierais ça à mon retour dans 3 semaines -ouacances- :o))
            si tu peux me relayer auprès de cowboy; merci d'avance
            0
          2. Modérateur
            Oui, je ne connaissais pas non plus... Mais ça c'était avant! 😉

            Je prends le relais alors, pas de souci.
            En attendant son retour...

            Bonnes vacances à toi.
            Amitiés
            Franck
            0
        2. Bonjour Michel,

          Je ne suis pas sûr d'avoir bien procéder mais voilà le lien pour les fichiers.

          https://www.cjoint.com/?3HgoNBfAGX1

          J'espère que ça marchera.

          A bientôt

          Cowboy56
          0
          1. Modérateur
            Salut,

            A la demande de Michel, je vais prendre le relais. Vacances obligent!!!
            Je télécharge ça, regarde et reviens vers toi.
            0
          2. Modérateur
            J'ai les trois fichiers.
            Pas de souci.
            Que veux tu faire exactement?

            Si j'ai bien compris...
            Dans le classeur "Planning général" tu as une liste de noms en colonne B (avec ou sans vides???).
            Tu veux aller chercher, dans toutes les feuilles des deux autres classeurs, toutes les lignes contenant le nom en colonne B et rapatrier vers Planning général toutes ces lignes. Les mettre l'une sous l'autre???
            C'est quelque chose comme ça?
            0
        3. Bonjour pijaku,

          Effectivement, je veux rapatrier les données des deux plannings, Exploitation et Maintenance vers le Planning General mais surtout par nom.
          L'ordre des noms dans les plannings Exploitation et Maintenance peuvent bouger.

          Cowboy56
          0
          1. Modérateur
            Et les résultats tu les veux comment?
            Triés par nom?
            les uns sous les autres?
            0
          2. Modérateur
            oula, je viens de me rendre compte d'autre chose... Les feuilles!
            Tu veux un récap par feuille? Les feuilles ont elles le même nom dans chacun des classeurs?

            C'est ch**nt de ne pas avoir les classeurs tels qu'ils sont en réalité.................
            0
        4. pijaku,

          Quelques explications

          Chaque classeur comportera 18 onglets, les mêmes pour les trois classeurs à savoir, les mois sur 1 an et demi
          Chaque onglet comportera un tableau, toujours le même pour chaque classeur
          les tableaux du classeur "Planning Général" comportera tous les noms, ceux des tableaux Exploitation et maintenance, environ 30
          Les tableaux Exploitation et Maintenance comporteront chacun environ 15 noms
          les données du mois de janvier des classeurs Exploitation et Maintenance doivent être rapatriées dans l'onglet janvier du classeur Général et ainsi de suite.

          Merci pour l'effort mais je ne veux pas abuser, ma mauvaise connaissance du VBA me conduit peut-être à penser à des choses impossibles. Si l'usine à gaz est trop complexe, il y a peut-être moyen de simplifier, je suis ouvert.

          Merci encore
          0
          1. Modérateur
            Salut,

            Tes explications devraient suffire.
            Une macro semble être le meilleur moyen de ne pas faire d'usine à gaz.

            Par contre, pour fonctionner, il faudra que les 3 fichiers soient ouverts (sur le même pc, ça semble évident mais je préfères le dire...). Pour travailler avec des fichiers fermés (c'est faisable également), il me faudrait d'autres informations (répertoire d'accès etc...).
            Cela te convient-il comme cela?

            ps : tu n'abuses pas du tout. Si tu voyais certaines demandes pleines d'imprécisions et d'impolitesses.....
            0
        5. Modérateur
          Voilà un premier jet.
          Sans Find...

          Attention, pour le tester, tu dis ABSOLUMENT travailler sur des copies de tes fichiers. En effet, les données des feuilles du Planning Général sont effacées avant importation.

          Voici la macro (à placer dans un module du planning général), testes la et reviens me dire tout ce qui ne convient pas.
          Sub Importer()
          'Variables utiles à la boucle
          Dim Wbk As Workbook 'classeurs
          Dim Wsh As Worksheet 'feuilles
          'Variables utiles pour déterminer la plage
          Dim Dlig As Long 'dernière ligne remplie
          'Variables tableau pour le stockage et la restitution des données
          Dim Tb(), Indic As Long
          'variables numériques pour les boucles sur la variable tableau
          Dim i As Long, j As Long

          'Effacement des données précédemment recueillies !!!!!!!!!!!!!!!!!!!!!!!
          For Each Wsh In ThisWorkbook.Worksheets
          Wsh.Cells.Clear
          Next Wsh

          'Pour tous les classeurs ouverts dans l'application
          For Each Wbk In Application.Workbooks
          'Si le classeur n'est pas le planning général (celui qui contient la macro)
          If Wbk.Name <> ThisWorkbook.Name Then
          'Pour toutes les feuilles de ce classeur (différent de ThisWorkbook)
          For Each Wsh In Wbk.Worksheets
          'Dans la feuille en cours
          With Wsh
          'dernière ligne remplie de la colonne B
          Dlig = .Range("B" & Rows.Count).End(xlUp).Row
          'stockage des données contenues dans les 60 colonnes et x lignes de cette plage
          'Si cellule en B non vide
          For i = 1 To Wsh.Range("B5:B" & Dlig).Cells.Count
          If Wsh.Cells(i + 4, 2) <> "" Then
          Indic = Indic + 1
          ReDim Preserve Tb(1 To 60, 1 To Indic)
          For j = 1 To 60
          Tb(j, Indic) = Wsh.Cells(i + 4, j + 1)
          Next j
          End If
          Next i
          End With
          'Restitution des données dans la feuille du même nom
          With ThisWorkbook.Worksheets(Wsh.Name)
          Dlig = .Range("B" & Rows.Count).End(xlUp).Row + 1
          If Dlig = 2 Then Dlig = 5
          .Range("B" & Dlig).Resize(UBound(Tb, 2), UBound(Tb, 1)) = Application.Transpose(Tb)
          End With
          'Effacement de la variable tableau
          Erase Tb
          Indic = 0
          Next Wsh
          End If
          Next Wbk
          End Sub

          0
          1. Salut Pijaku,

            Merci pour ce premier jet, je test cela ce soir et je reviens vers toi.

            Bonne journée
            0
            1. Pijaku,

              Me revoilà, j'ai fait le test, ça ne fonctionne pas et je ne sais pas pourquoi, j'ai bien ouvert les trois fichiers comme tu l'a dis pourtant.
              Je t'envoie l'erreur que j'obtiens, entre les deux captures d'écran, il y a juste une pression sur F8.

              https://www.cjoint.com/?3HhtMMuulFL

              Regarde ce que tu peux faire et tiens moi au courant.

              Merci
              0
              1. Modérateur
                Salut,

                Comme ça, à vue de nez, je dirais que tu as une feuille "mal nommée".
                Du style une feuille nommée "Fev " au lieu de "Fev" avec un espace, ou un accent qui ne figure pas dans le planning général.
                J'ai testé la macro sur les fichiers que tu m'as transmis et cela fonctionne.
                0
            2. Salut,

              Ok, compris, ce soir je passe l'ensemble des fichiers et onglets à la vérification et je te tiens au courant

              Bonne journée
              0
              1. Bonsoir pijaku

                J'ai revu mes fichiers, vérifier mes onglets ainsi que les noms, rien à faire, la procédure ne fonctionne pas. Impossible pour moi de dire pourquoi. De mon coté, j'ai avancé sur ma première procédure et j'ai réussi à trouver une solution qui marche, en fait il faudra deux macros mais ça le fait. il me reste à
                1- Gérer les erreurs (absence de noms ou doublon dans l'un des fichiers, problème quelconque sur un des fichiers, etc...)
                2- Gérer le passage d'onglet en onglet (Je préférerais travaillé en +1 plutôt qu'avec les noms des onglets)

                je veux bien essayer ta macro avec les fichiers sur lesquels ça fonctionne, si tu peux me les envoyés.

                Merci pour tes efforts

                Cowboy56
                0
                1. Merci à tous ceux qui se sont penché sur mon problème, je mets le résultat de ce que j'ai trouvé, il y a certainement des erreurs dans les commentaires mais ça fonctionne, je vais m'en m'en contenter. j'ai remarqué que certaine procédure ne marchait pas chez moi, cela vient de la version office qui est très ancienne. je vais évoluer et reprendrai les macros ensuite.

                  Merci encore à tous.

                  Sub Cherche()
                  'code pour éviter de voir le défilement de la macro
                  Application.ScreenUpdating = False
                  'code pour éviter les alertes de vidange du presse-papier
                  Application.DisplayAlerts = False
                                  'code pour effacer les données de toutes les feuilles
                                  Dim w As Object
                                      For Each w In Worksheets
                                      Sheets(w.Name).[C5:BJ35].ClearContents
                                  Next
                                  
                  'définition de la variable f
                  Dim f As Variant
                  'f = la feuille active
                  f = ActiveSheet.Index
                  'calcul du nombre de feuille total du fichier
                  totalSheets = ActiveWorkbook.Sheets.Count
                  'f = feuille courante
                  curentSheet = f
                  'Set plageC = Application.ActiveWorkbook.ActiveSheet.UsedRange.Columns("A").Cells
                  'action si la feuille courante est plus petite que le total des feuilles
                  Do Until curentSheet > totalSheets
                  'renommer la feuille active
                  f = curentSheet
                  'selectionner le classeur et la feuille courante
                  ActiveWorkbook.Sheets(curentSheet).Select
                  'avec cette selection
                  With Selection
                  
                                  
                      'Variables pour trouver les plages de traitement
                      Dim Trouve As Range, PlageDeRecherche As Range
                      'Variables pour les noms à traiter
                      Dim Valeur_Cherchee As String, AdresseTrouvee As String
                      Dim i As Range
                                  'Chercher dans la base de noms
                                  For Each i In Range("BK1:BK6").Cells
                                      'numeroter les noms
                                      Valeur_Cherchee = i.Value
                                      'ouvrir le classeur exploitation
                                      ChDir "G:\2 - EXPLOITATION"
                                      Workbooks.Open Filename:="G:\2 - EXPLOITATION\Planning Exploitation.xls"
                                      Sheets(f).Select
                                      'Selectionner la cellule A1
                                      Range("A1").Activate
                          'Dans la plage B5:B35
                          Set PlageDeRecherche = Range("B5:B35")
                          'Chercher le nom et l'appeler trouve
                          Set Trouve = PlageDeRecherche.Cells.Find(What:=Valeur_Cherchee, LookAt:=xlWhole)
                                      'S'il n'existe pas
                                      If Trouve Is Nothing Then
                                          'Panneau
                                          MsgBox Valeur_Cherchee & " n'est pas présent dans l'onglet " & (f) & " du fichier EXPLOITATION"
                                          'Sortir e la procedure
                                          Exit Sub
                                      'sinon
                                      Else
                                          ' l'appeler Adressetrouvee
                                          AdresseTrouvee = Trouve.Address
                                      'fin du si
                                      End If
                                          'selectionner la cellule
                                          Range(AdresseTrouvee).Activate
                                          'etendre la selection
                                          Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count + 60).Select
                                          'copier
                                          Selection.Copy
                                          'activer le planning general
                                          Windows("Planning General.xls").Activate
                                          'Chercher le meme nom que celui copier
                                          Range("B5:B35").Find(What:=Valeur_Cherchee, LookIn:=xlValues, LookAt:=xlWhole).Activate
                                          'coller
                                           ActiveSheet.Paste
                      'fin de i
                      Next i
                      
                  End With 'fin du traitement de la feuille
                  curentSheet = curentSheet + 1 'feuille suivante
                  Loop 'Fi
                                  'activer la cellule A1
                                  Range("A1").Activate
                      'Next f
                          'Fermer le fichier exploitation
                          Windows("Planning Exploitation.xls").Close
                  'Desactiver la plage de rechche
                  Set PlageDeRecherche = Nothing
                  'Desactiver la recherche de "trouve"
                  Set Trouve = Nothing
                  'Réactiver les alertes
                  Application.DisplayAlerts = True
                  'Reactiver le défilement de la macro
                  Application.ScreenUpdating = True
                  'Fin de la macro
                  End Sub
                  0