Compiler des données de plusieurs fichiers

Bonjour à tous,

J'ai besoin de récupérer des données se trouvant sur un ensemble de fichier, en un seul fichier, et en effectuant une selection sur les lignes des différents fiuchiers.

Mon code pour récupérer les données d'un fichier est le suivant :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Sub remplirfeuille(nomfichier As String) Dim appExcel As Excel.Application 'Application Excel Dim wsExcel As Excel.Worksheet 'Feuille Excel   Set appExcel = CreateObject("Excel.Application") Set wbExcel = appExcel.Workbooks.Open(nomfichier) Set wsExcel = wbExcel.Worksheets("REMISE EN FORME") i = 2 Do While wbExcel.Worksheets("REMISE EN FORME").Cells(i, 3) <> "" If wbExcel.Worksheets("REMISE EN FORME").Cells(i, 1) = "BON" Then wbExcel.Worksheets("REMISE EN FORME").Range("A" & i & ":DG" & i).Copy Worksheets(1).Range("A" & ligne_courante & ":DG" & ligne_courante).PasteSpecial xlPasteValues ligne_courante = ligne_courante + 1 End If i = i + 1 Loop End Sub

---

Je rajoute à la feuille courante les données que je lis dans le fichier, lorsque la ligne est bonne (flag "BON").
Je fais ça sur une 60aine de fichier que je met bout à bout, mais avec mon implémentation c'est très lent.

Yaurait t'il 1 moyen de faire un filtre sur la 1ère colonne sur "BON", et de selectionner puis copier/coller toutes les lignes d'un coup, le tout en vba bien sur?

merci

Déjà, tu peux ajouter
Application.screenUpdating = false après les déclarations pour le remettre à True en fin de macro.
Application.screenUpdating = false accélère le code même si tu ne sélectionnes pas les cellules dans un copier/coller
Pour ta question : Tu peux filtrer ta base sur bon puis ne copier que les lignes visibles. Un code qui fonctionne selon ce principe.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sub FiltrerCopierColler() Dim FL1 As Worksheet Dim FL2 As Worksheet Dim plage As Range, NoLigne As Long Dim Cell as Range Application.ScreenUpdating = False Set FL1 = Worksheets("feuil1") Set FL2 = Worksheets("feuil3") Columns("A:A").AutoFilter Field:=1, Criteria1:="BON" DerniereLigne = Range("A65535").End(xlUp).Row Set plage = FL1.Range("A1:A" & DerniereLigne).SpecialCells(xlCellTypeVisible) For Each Cell In plage NoLigne = NoLigne + 1 Cell.EntireRow.Copy FL2.Range("A" & NoLigne).PasteSpecial Paste:=xlPasteValues Next Set FL1 = Nothing Set FL2 = Nothing Set plage = Nothing Set Cell = Nothing Application.ScreenUpdating = True End Sub

---

A adapter ;)
A+