Se connecter avec
S'enregistrer | Connectez-vous

Importer des Lignes de plusieurs fichier contenant une valeur dans un autre

Dernière réponse : dans Programmation

Bonjour à tous,
Je travail avec Office 2010 et je cherche à produire une macro qui me permettrait de chercher dans plusieurs fichier d'un même dossier, à partir d'un autre fichier, une valeur variable inscrite dans la colonne précédent une valeur fixe et importé l'intégralité des lignes contenant cette valeur variable dans la colonne "C".
Ex :
Dans le fichier « A », situé dans le dossier « Y », j’exécute la macro et je cherche la valeur « surv. ».
Dans le fichier « B », situé dans le dossier « X »,se trouve la valeur « surv. » en G14. J’importe alors l’entête du fchier « B » se trouvant en (B3:E7) et je prends F14 que je recherche dans la colonne C du fichier « B ». J’importe alors toutes les lignes du fichier « B », ayant cette valeur en «C 20» à « C120 », dans le fichier « A » feuille 2. Ainsi de suite pour le fichier « C, D, E, … » contenu dans le Dossier « X ».
Voilà ou j’en suis :

  1. Sub Recherche_ligne()
    

  2.  
  3.     Dim Dossier As String
    

  4.     Dim Fichier_X As String
    

  5.     Dim Fichier_A As String
    

  6.     Dim MyFind As Variant
    

  7.     Dim FoundCell As Object
    

  8.     Dim Counter As Long
    

  9.  
  10.     ' ---------------------------------
    

  11.     MyFind = "surv."
    

  12.     If MyFind = "" Then End
    

  13.     Counter = 0
    

  14.     Fichier_A = "Fichier_A.xls"
    

  15.  
  16.     On Error Resume Next
    

  17.     '------------------------------------------------
    

  18.  
  19.     Set FS = CreateObject("Scripting.FileSystemObject")
    

  20.  
  21.     'Dans le dossier Y
    

  22.     Set Dossier_Y = FS.GetFolder
    

  23.  
  24.     'Dans les Fichiers ".XLS"
    

  25.     Set Fichier_X = Dossier.Files
    

  26.  
  27.     'Dans la feuille 1
    

  28.     Set ws = Worksheets("Feuil1")
    

  29.  
  30.     Do
    

  31.         Workbooks.Open Fichier_X
    

  32.         Set FoundCell = ws.Cells.Find(what:=MyFind)
    

  33.         If Not FoundCell Is Nothing Then
    

  34.  
  35.            FirstAddress = FoundCell.Address
    

  36.            Do
    

  37.               Counter = Counter + 1
    

  38.               FoundCell.EntireRow.Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    

  39.               ThisWorkbook.ws.Cells.FindNext(FoundCell)
    

  40.            Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
    

  41.         End If
    

  42.  
  43.     Loop While Fichier <> ""
    

  44.     rsp = MsgBox(Counter & " Résultats trouvés")
    

  45.  
  46. End Sub


Merci de votre aide!

Autres pages sur : importer lignes plusieurs fichier contenant valeur

Lassé par la pub ? Créez un compte

Bonjour,

Je vois déjà ce que va te dire Zeb. Alors avant qu'il se fâche tout rouge ( :fou:  ), lis le règlement, et en particulier :

Le règlement stipule que toute pièce de code doit être présentée grâce à la balise [code]

De rien ;) 
Expert Programmation

Salut,

M'enfin, Excel sait travailler avec plusieurs fichiers. Il faut donc que son système de macro puisse le faire aussi.
Par ailleurs ce système est le Visual Basic. Heureusement qu'un tel langage sait ouvrir plusieurs fichiers :/ 
Expert Programmation

Ohlala, je viens de lire le code ! Il y a du pas mal du tout là-dedans :) , des approximations :/  , et aussi des erreurs grossières :( .

Ligne 25, tu utilises Dir() pour charger ta variable Fichier mais il manque le rechargement de cette variable à la fin de la boucle !
(Relis l'aide sur Dir()).

Ligne 28, tu utilises une variable pour ta feuille. Eh, fais-en autant pour tes classeurs !

Ligne 36, c'est quoi Liste ?

Revois ça.

--------------

Je n'aime pas la fonction Dir(). C'est comme ça :spamafote:  Dans mes exemples, j'utiliserai FileSystemObject. Je t'invite à te renseigner sur cet objet pour bien les comprendres.
Expert Programmation

Arfff... T'as tout changé dans ton premier message. Du coup, les messages suivants ne sont plus pertinents. Spa grave. Je relis ton code et je reprends.
Expert Programmation

Pour commencer, quelques commentaires :
  1. Sub Recherche_ligne()
  2.  
  3.     Dim Dossier As String
  4.     Dim Fichier_X As String
  5.     Dim Fichier_A As String
  6.     Dim MyFind As Variant ' // <-- Pourquoi pas un String ?
  7.     Dim FoundCell As Object
  8.     Dim Counter As Long
  9.  
  10.     ' ---------------------------------
  11.     MyFind = "surv."
  12.     ' // Euh... On est un peu sûr du résulat ;)    
  13.     If MyFind = "" Then End
  14.     Counter = 0
  15.     Fichier_A = "Fichier_A.xls"
  16.  
  17.     On Error Resume Next
  18.     '------------------------------------------------
  19.  
  20.     ' // Oui et après ? :D
  21.     ' // La variable n'est pas déclarée
  22.     Set FS = CreateObject("Scripting.FileSystemObject" )
  23.  
  24.     'Dans le dossier Y
  25.     ' // Euh... Faut donner un chemin, là !
  26.     ' // La variable n'est pas déclarée
  27.     Set Dossier_Y = FS.GetFolder
  28.  
  29.     'Dans les Fichiers ".XLS"    
  30.     ' // Lapin compris ce que tu cherches.
  31.     ' // Dossier est une chaîne.
  32.     Set Fichier_X = Dossier.Files
  33.     'Dans la feuille 1
  34.     ' // Dans quel classeur ?
  35.     Set ws = Worksheets("Feuil1" )
  36.  
  37.     Do
  38.         ' // Et ma variable pour classeur ?
  39.         Workbooks.Open Fichier_X
  40.         Set FoundCell = ws.Cells.Find(what:=MyFind)
  41.         If Not FoundCell Is Nothing Then
  42.             ' // La variable n'est pas déclarée
  43.             FirstAddress = FoundCell.Address
  44.             Do
  45.                 Counter = Counter + 1
  46.                 FoundCell.EntireRow.Copy Destination:=Sheets("Feuil2" ).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  47.                 ' // Ohlala !!!!
  48.                 ThisWorkbook.ws.Cells.FindNext(FoundCell)
  49.             Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
  50.         End If
  51.     ' // Cette variable n'existe plus.
  52.     Loop While Fichier <> ""
  53.     ' // Pas de majuscule à résultat. Et la gestion du pluriel ?
  54.     rsp = MsgBox(Counter & " Résultats trouvés" )
  55. End Sub
Expert Programmation

Au départ, je voulais que tu te concentres sur les fichiers, les classeurs et les feuilles. Je t'aurai fait le FSO.
Bah, spa grave.

D'abord, deux petites choses : ajoute Microsoft Scripting Runtime (scrrun.dll) à tes références et utilise l'Option explicit, ce qui t'obligera à déclarer tes variables.

Comment boucler sur une liste de fichier ?
  1. Dim FS     As New FileSystemObject
    

  2. Dim file   As Scripting.file
    

  3. Dim folder As Scripting.folder
    

  4.  
  5. Set folder = FS.GetFolder(Environ("USERPROFILE"))
    

  6. ' // Si le dossier n'existe pas, VB s'arrête.
    

  7.  
  8. For Each file In folder.Files
    

  9.     MsgBox file.Path
    

  10.     ' // Faire quelque chose de ce fichier
    

  11.  
  12. Next


Comment filtrer sur un type de fichier particulier ?
  1. If ucase(file.Name) Like "*.XLS" Then


Allez, on y est presque. ;) 

Un gros merci Zeb, ca m'a donné un bon coup de main!

Me reste plus qu'a boucler dans le fichier.

Voilà ou j'en suis : 

  1. Sub Rech_line_In_XLS_of_One_Folder()
    

  2.  
  3.     'Fonction de la macro : Rechercher une ligne contenant "SURV" dans plusieurs fichier Excel d'un dossier
    

  4.     '-------------------------------------------------
    

  5.     'Déclaration de variable
    

  6.     '-------------------------------------------------
    

  7.  
  8.     Dim FS                  As New FileSystemObject
    

  9.     Dim Dossier_Y           As Scripting.folder
    

  10.     Dim Path_Dossier_Y      As String
    

  11.     Dim Fichier_X           As Scripting.file
    

  12.  
  13.     Dim Feuille             As Worksheet
    

  14.     Dim Recherche_cell      As Object   'Cellule ou se trouve la valeur cherché
    

  15.  
  16.     Dim Premiere_Addresse   As Object   'Première Adresse d'écriture de résultat
    

  17.     Dim Adresse_Actuel      As Object   'Adresse ou se trouve le dernier résultat copié
    

  18.     Dim Adresse_No_Compte   As Object   'Adresse ou se trouve le no de compte du batiment dans le fichier XLS
    

  19.     Dim Adresse_No_Client   As Object   'Adresse ou se trouve le no de client du batiment dans le fichier XLS
    

  20.     Dim Adresse_Batiment    As Object   'Adresse ou se trouve le nom du batiment dans le fichier XLS
    

  21.  
  22.     Dim MyFind              As String   'La valeur chercher dans le fichier .XLS
    

  23.     Dim Compteur_Resultat   As Long     'Compteur de résultat dans le fichier .XLS
    

  24.     Dim Compteur_Res_total  As Long     'Compteur de résultat dans tout les fichier .XLS
    

  25.     Dim Compteur_Bat        As Long     'Competur de fichier .XLS
    

  26.  
  27.     '-------------------------------------------------
    

  28.     'Valeur de départ
    

  29.     '-------------------------------------------------
    

  30.  
  31.     'Défini les lignes de l'entête de chaque fichier
    

  32.     'Adresse_No_Compte = Range("b3")
    

  33.     'Adresse_No_Client = Range("b4")
    

  34.     'Adresse_Batiment = Range("b7")
    

  35.  
  36.     MyFind = "24HR / AUX"
    

  37.     Compteur_Resultat = 0
    

  38.     Compteur_Res_total = 0
    

  39.     Compteur_Bat = 0
    

  40.     Set FS = CreateObject("Scripting.FileSystemObject")
    

  41.  
  42.     'Dans le dossier Y
    

  43.     Path_Dossier_Y = "c:\Dossier_Y"
    

  44.     Set Dossier_Y = FS.GetFolder(Path_Dossier_Y)
    

  45.  
  46.     '--------------------------------------------------
    

  47.     'Programmation
    

  48.     '--------------------------------------------------
    

  49.  
  50.     For Each Fichier_X In Dossier_Y.Files
    

  51.  
  52.         If UCase(Fichier_X.Name) Like "*.XLS" Then
    

  53.  
  54.             Compteur_Bat = Compteur_Bat + 1
    

  55.             Compteur_Resultat = 0
    

  56.             'Ouvre le fichier_X
    

  57.             Workbooks.Open Fichier_X
    

  58.  
  59.             'Dans la feuille 1
    

  60.             Set Feuille = Worksheets("Feuil1")
    

  61.             Set Recherche_cell = Feuille.Cells.Find(what:=MyFind)
    

  62.  
  63.             '------------------------------------------
    

  64.             'Copie l'entête avant les lignes résultats
    

  65.             'Adresse_Batiment.EntireRow.Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    

  66.             'Adresse_No_Compte.EntireRow.Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    

  67.             'Adresse_No_Client.EntireRow.Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    

  68.             '------------------------------------------
    

  69.  
  70.             If Not Recherche_cell Is Nothing Then
    

  71.  
  72.                 Premiere_Addresse = Recherche_cell.Address
    

  73.  
  74.                 Do
    

  75.                     Compteur_Resultat = Compteur_Resultat + 1
    

  76.                     Compteur_Res_total = Compteur_Res_total + 1
    

  77.                     Recherche_cell.EntireRow.Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    

  78.                     Set Recherche_cell = Feuille.Cells.FindNext(Recherche_cell)
    

  79.  
  80.                 Loop While Not Recherche_cell Is Nothing _
    

  81.                 And Recherche_cell.Address <> Premiere_Addresse
    

  82.  
  83.             End If
    

  84.             MsgBox (Compteur_Resultat & " résultat(s) trouvé(s) dans " & Fichier_X)
    

  85.             ActiveWindow.Close
    

  86.         End If
    

  87.     Next
    

  88.     'A titre informatif
    

  89.     MsgBox (Compteur_Res_total & " résultat(s) trouvé(s) au total dans " & Compteur_Bat & " batiment(s)")
    

  90.  
  91. End Sub
Expert Programmation

Etudie les différences entre ton code et cet extrait que je te propose :
  1. Dim classeur_X As Workbook
  2. Dim feuille_X1 As Wokrsheet
  3.  
  4. Compteur_Bat = Compteur_Bat + 1
  5. Compteur_Resultat = 0
  6. ' // Ouvre le classeur_X/fichier_X
  7. Set classeur_X  = Workbooks.Open(Fichier_X)
  8. ' // Dans la feuille 1 du classeur_X
  9. Set feuille_X1 = classeur_X.Worksheets(1)
  10. Set Recherche_cell = feuille_X1.Cells.Find(what:=MyFind)
  11. If Not Recherche_cell Is Nothing Then
  12.     Premiere_Addresse = Recherche_cell.Address
  13.     Do
  14.         Compteur_Resultat = Compteur_Resultat + 1
  15.         Compteur_Res_total = Compteur_Res_total + 1
  16.         Recherche_cell.EntireRow.Copy Destination:=ThisWorkbook.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  17.         Set Recherche_cell = feuille_X1.Cells.FindNext(Recherche_cell)
  18.  
  19.     Loop While Not Recherche_cell Is Nothing _
  20.            And Not Recherche_cell.Address <> Premiere_Addresse
  21. End If
  22. MsgBox (Compteur_Resultat & " résultat(s) trouvé(s) dans " & Fichier_X)
  23. classeur_X.Close(False)

Hey Zeb,

Ca fonctionne!!!

J'y serais pas arriver sans toi! Merci!

Bon, bien sur, c'est pas encore la perfection mais je réussi en tirer ce que je veux.

Voici le bug:

Ma ligne de copie de résultat, comme à la ligne 16 de ton précédent message, ne s'incrémente pas. C'est à dire qu'a chaque passage elle écrase le résultat précédent. J'ai régler le problème en ajoutant un compteur de ligne que j'ai placé dans le rowOffset de la fonction Offset().

Pourtant, quand j'exécute cette commande dans une autre macro d'un autre fichier, pas de problème. Par contre, cet autre fichier est en Excel 2003.

Voila le code presque final :sweat:  

  1. Sub Rech_line_In_XLS_of_One_Folder()
    

  2.  
  3.     'Fonction de la macro : Rechercher une ligne contenant les caractères de b15 dans plusieurs fichier Excel d'un dossier dont le chemin est en b12
    

  4.     '-------------------------------------------------
    

  5.     'Déclaration de variable
    

  6.     '-------------------------------------------------
    

  7.  
  8.     Dim FS                  As New FileSystemObject
    

  9.     Dim Dossier_Y           As Scripting.folder
    

  10.     Dim Path_Dossier_Y      As String
    

  11.     Dim Fichier_X           As Scripting.file
    

  12.     Dim Feuille             As Worksheet
    

  13.     Dim Classeur            As Workbook
    

  14.  
  15.     Dim Recherche_cell      As Object   '// Cellule ou se trouve la valeur cherché
    

  16.     Dim Premiere_Addresse   As String   '// Première Adresse d'écriture de résultat
    

  17.     Dim MyFind              As String   '// La valeur chercher dans le fichier .XLS
    

  18.     Dim Compteur_Resultat   As Long     '// Compteur de résultat dans le fichier .XLS
    

  19.     Dim Compteur_Res_total  As Long     '// Compteur de résultat dans tout les fichier .XLS
    

  20.     Dim Compteur_Bat        As Long     '// Compteur de fichier .XLS
    

  21.     Dim Line                As Long     '// Compteur de line dans le fichier résultat
    

  22.  
  23.     '// -------------------------------------------------
    

  24.     '// Valeur de départ
    

  25.     '// -------------------------------------------------
    

  26.  
  27.     '// Nettoie la feuille résultat précédents
    

  28.     ThisWorkbook.Worksheets("Resultat").Rows("1:65536").Delete Shift:=xlUp
    

  29.  
  30.     MyFind = ThisWorkbook.Worksheets("Prog").Cells(15, 2)
    

  31.     Compteur_Resultat = 0
    

  32.     Compteur_Res_total = 0
    

  33.     Compteur_Bat = 0
    

  34.     Line = 0
    

  35.  
  36.     Set FS = CreateObject("Scripting.FileSystemObject")
    

  37.  
  38.     '// Dans le dossier Y
    

  39.     Path_Dossier_Y = ThisWorkbook.Worksheets("Prog").Cells(12, 2)
    

  40.     Set Dossier_Y = FS.GetFolder(Path_Dossier_Y)
    

  41.  
  42.     '// --------------------------------------------------
    

  43.     '// Programmation
    

  44.     '// --------------------------------------------------
    

  45.  
  46.     For Each Fichier_X In Dossier_Y.Files
    

  47.  
  48.         If UCase(Fichier_X.Name) Like "*.XLS" Then
    

  49.  
  50.             Compteur_Bat = Compteur_Bat + 1
    

  51.             Compteur_Resultat = 0
    

  52.  
  53.             '// Ouvre le fichier_X
    

  54.             Set Classeur = Workbooks.Open(Fichier_X)
    

  55.  
  56.             '// Dans la feuille 1
    

  57.             Set Feuille = Classeur.Worksheets("Feuil1")
    

  58.  
  59.             '// Définit la cellule a chercher dans la feuille
    

  60.             Set Recherche_cell = Feuille.Cells.Find(what:=MyFind)
    

  61.  
  62.             If Not Recherche_cell Is Nothing Then
    

  63.  
  64.                 '// Copie l'entête avant les lignes résultats
    

  65.                 Feuille.Rows("3:3").Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  66.                 Line = Line + 1
    

  67.                 Feuille.Rows("4:4").Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  68.                 Line = Line + 1
    

  69.                 Feuille.Rows("7:7").Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  70.                 Line = Line + 1
    

  71.                 Feuille.Rows("18:18").Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  72.                 Line = Line + 1
    

  73.                 Feuille.Rows("19:19").Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  74.                 Line = Line + 1
    

  75.                 '// ------------------------------------------
    

  76.  
  77.                 Premiere_Addresse = Recherche_cell.Address
    

  78.  
  79.                 Do
    

  80.                     Compteur_Resultat = Compteur_Resultat + 1
    

  81.                     Compteur_Res_total = Compteur_Res_total + 1
    

  82.                     '// On Copie la ligne de la cellule trouvé
    

  83.                     Recherche_cell.EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  84.                     Line = Line + 1
    

  85.                     '// On passe à la prochaine
    

  86.                     Set Recherche_cell = Feuille.Cells.FindNext(Recherche_cell)
    

  87.  
  88.                 Loop While Not Recherche_cell Is Nothing _
    

  89.                 And Recherche_cell.Address <> Premiere_Addresse
    

  90.  
  91.             End If
    

  92.             Classeur.Close (False)
    

  93.         End If
    

  94.         '// Ligne de séparation entre les résultat d'un fichiers d'un autre
    

  95.         Line = Line + 1
    

  96.     Next
    

  97.     '// A titre informatif
    

  98.     MsgBox (Compteur_Res_total & " résultat(s) trouvé(s), au total, dans " & Compteur_Bat & " batiment(s)")
    

  99.  
  100. End Sub
Expert Programmation

Salut,

  1. For Each Fichier_X In Dossier_Y.Files
Tu voudrais bien resté cohérent avec tes X et des Y.

Pas bien compris ton problème, mais j'ai repéré un tout petit bug., ligne 83.

  1. Recherche_cell.EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Resultat" ).Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)

Tout les objets sont bien désignés sauf le nombre de lignes. On ne sait pas de quelles zone il s'agit. Voià comment il faudrait l'écrire :
  1. Recherche_cell.EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Resultat" ).Cells(ThisWorkbook.Worksheets("Resultat" ).Rows.Count, 1).End(xlUp).Offset(Line, 0)


C'est un peu lourd.

J'ai pris l'habitude de faire autrement. J'ai une "source" dans laquelle je lis et une "cible" vers laquelle j'écris.
  1. Dim FS       As New FileSystemObject ' // Microsoft Scripting Runtime : %windir%\system32\scrrun.dll
    

  2. Dim wanted   As String
    

  3. Dim cell_trg As Range
    

  4. Dim cell_src As Range
    

  5. Dim f_src    As File
    

  6. Dim wb_src   As Workbook
    

  7. Dim ws_src   As Worksheet
    

  8. Dim address1 As String
    

  9.  
  10. wanted = ThisWorkbook.Worksheets("Prog").Range("B15").Text
    

  11.  
  12. ' // Cible (target)
    

  13. ThisWorkbook.Worksheets("Resultat").Cells.Clear
    

  14. Set cell_trg = ThisWorkbook.Worksheets("Resultat").Range("A1")
    

  15.  
  16. For Each f_src In FS.GetFolder(ThisWorkbook.Worksheets("Prog").Range("B12"))
    

  17.     If UCase(f_src.Name) Like "*.XLS" Then
    

  18.         Set wb_src = Workbooks.Open(f_src.Path, ReadOnly:=True)
    

  19.         Set ws_src = wb_src.Worksheets(1)
    

  20.  
  21.         Set cell_src = ws_src.Cells.Find(wanted)
    

  22.  
  23.         If Not cell_src Is Nothing Then
    

  24.  
  25.             '// Copie l'entête avant les lignes résultats
    

  26.             ws_src.Rows(3).Copy cell_trg
    

  27.             Set cell_trg = cell_trg.Offset(1)
    

  28.             ws_src.Rows(4).Copy cell_trg
    

  29.             Set cell_trg = cell_trg.Offset(1)
    

  30.             ws_src.Rows(7).Copy cell_trg
    

  31.             Set cell_trg = cell_trg.Offset(1)
    

  32.             ws_src.Rows(18).Copy cell_trg
    

  33.             Set cell_trg = cell_trg.Offset(1)
    

  34.             ws_src.Rows(19).Copy cell_trg
    

  35.             Set cell_trg = cell_trg.Offset(1)
    

  36.  
  37.             address1 = cell_src.Address
    

  38.             Do
    

  39.                 cell_src.EntireRow.Copy cell_trg
    

  40.                 Set cell_trg = cell_trg.Offset(1)
    

  41.                 Set cell_src = ws_src.Cells.FindNext(cell_src)
    

  42.             Loop While Not cell_src Is Nothing _
    

  43.                    And Not cell_src.Address = address1
    

  44.  
  45.         End If
    

  46.         wb_src.Close savechanges:=False
    

  47.     End If
    

  48.     '// Ligne de séparation entre les résultat d'un fichiers d'un autre
    

  49.     Set cell_trg = cell_trg.Offset(1)
    

  50. Next
Expert Programmation

Je ne suis pas très satisfait des lignes 26 à 35. Ça manque de concision.

Factorisons : 
  1. For Each i In Array(3, 4, 7, 18, 19)
    

  2.     ws_src.Rows(i).Copy cell_trg
    

  3.     Set cell_trg = cell_trg.Offset(1)
    

  4. Next
C'est mieux.

Voyons autre chose :
  1. ws_src.Range("3:4,7:7,18:19").Copy cell_trg
    

  2. Set cell_trg = cell_trg.Offset(5)
Pas mal non plus. C'est un peu moins hard-coder, mais c'est plus "expert Excel".

Quelle version préfères-tu ?

Salut Zeb,

J'ai essayé tes trucs avec tes "Range"

  1. Dim cell_trg As Range
    

  2. Dim cell_src As Range


De mon côté, ca ne donne pas le résultat voulu. Les résultats par fichier ce liste mais les fichiers s'écrase un par dessus l'autre.
J'ai donc conservé ma ligne de code (version corrigé) suivi de mon fameux compteur de ligne!! :whistle:  

  1. Recherche_cell.EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Resultat" ).Cells(ThisWorkbook.Worksheets("Resultat" ).Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  2. Line = Line +1


Par contre, j'ai révisé la copie de mon entête de fichier et grâce a ce que tu m'as donné, ca copie maintenant les cellules fusionné en plus de réduire le code. C'est génial!

  1. '// Copie l'entête avant les lignes résultats
    

  2. Feuille.Range("3:4,7:7,18:19").Copy Destination:=ThisWorkbook.Worksheets("Resultat").Cells(Rows.Count, 1).End(xlUp).Offset(Line, 0)
    

  3. Line = Line + 5


J'ai aussi récupéré ta remise à zéro de la feuille résultat.

  1. ThisWorkbook.Worksheets("Resultat" ).Cells.Clear


Ca a pour efffet, comparativement à mon "Delete", de garder les largeurs de ligne dans ma feuille "Résultat" intacte!

Merci Zeb, au plaisir!

bonjour,

j'ai à peu près la même problématique que toi, et en cherchant sur le net j'ai trouvé ce forum avec ce sujet qui m'intéresse fortement, mais afin de capitaliser votre expérience, pourrais tu me donner le code final qui fonctionne ?
par avance merci
Expert Programmation

Salut charentais 16,

capitaliser l'experiencec'est bien mais c'est pas en recopiant un code qui marche que tu arrivera a comprendre comment il fonctionne ni a l'adapter a ton cas. Le mieux serait que tu t'aide de ce qu'il y a ci dessus pour créer ton propre code.
Et si tu as un probleme, n'hésite pas a poster tes questions dans un nouveaux sujet (ca fait moins désordre), On t'orientera vers les reponses.

Expert Programmation

Salut zeb,

je ne suis jms parti tres loin mais il n'y avai plus de sujet ou je pouvais repondre... ou alors tu étais trop rapide...

Pour Charentais16 :
Le code complet et presque donné, assemble les réponses plus haut et tout le travail est fait. (reste qu'il te faudra qd meme ajuster a ton fichier) et sache que parfois partir sur un code tout fait et l'adapter est plus long que de partir de zéro !!

..
Expert Programmation

Si tu veux que nous fassions ton boulot à ta place, passe ton chemin.
Nous ne sommes pas là pour suppléer les carences de l'organisation de l'entreprise dans laquelle tu travailles.
(conforme au règlement)

Si tu veux t'autoformer, nous serions ravis de t'accompagner.
(conforme à l'idée de ce forum d'entraide)
Lassé par la pub ? Créez un compte

Créer un nouveau sujet