Discussion :

[kirua2150]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ouskel'n'or]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+