Discussion :

[cdurep]

Bonjour,

J'ai 2 classeurs, un source, un cible.
Je veux copier dans la feuille1 (il s'agit d'un tableau) de la cible toutes les lignes de la feuille1 (ce n'est pas un tableau) de la source qui contiennent la valeur "Clos" dans colonne 4 par exemple.

J'utilise une boucle de 1 à 90 pour copier chaque cellule source dans la cellule correspondante cible. C'est long !
Est-il possible de copier toute la ligne en une seule instruction ?
j'ai essayé plusieurs choses sans succès.

Merci d'avance de votre aide

[Philippe Tulliez]

Bonjour,
Ce que tu décris là peut être résolu facilement avec le filtre avancé d'excel (méthode AdvancedFilter de l'objet Range)

A lire Les filtres avancés ou élaborés dans Excel

[78chris]

Boujour à tous

Si la cible est un tableau structuré avec les colonnes dans le même ordre que la source, il suffit de faire un filtre auto et de copier l'ensemble des lignes de la plage source sur le 1ère cellule située sous la 1ère colonne du tableau

[unparia]

Bonjour
Je voudrais juste ajouter que le verbe appareiller n'a rien à voir avec le verbe apparier

[Menhir]

J'utilise une boucle de 1 à 90 pour copier chaque cellule source dans la cellule correspondante cible. C'est long !
Est-il possible de copier toute la ligne en une seule instruction ?

Il est étonnant que pour une si petite quantité la durée te paraisse longue (à moins que ce soit dans une macro évènementielle qui ralentit le fonctionnement usuel d'Excel).

La seule raison pourrait être que ton code soit bourré de Select ou que tu n'es pas choisi les bonnes instructions.
Mais pour corriger ça, il faudrait que tu montres ton code.

[cdurep]

Voilà le Code :

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Sub Extract_FFU()
 
'Définition des variables
    Dim objOuvrir As FileDialog
    Dim objFichiers As FileDialogSelectedItems
    Dim x As Long
    Dim Wb As Workbook
    Dim Source As Worksheet
    Dim Cible As Worksheet
    Dim DEST As Range
    DernièreColFFU = 90
    ColFFUEtatTicket = 4
    ColFFUTypeTicket = 58
    ColFFUEnvironnement = 40
    NomCible = ThisWorkbook.Name
    Set Cible = Workbooks(NomCible).Sheets("Format unique")
    DerligB = Cible.[A65536].End(xlUp).Row 'mémorisation de la dernière ligne Data
    'Cible.Range(Cells(2, 1), Cells(DerligB, DernièreColFFU)).ClearContents
 
'choix du fichier FFU mensuel à traiter
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ""
        .Filters.Clear 'Efface les filtres existants.
        .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm" 'Définit une liste de filtres pour le champ "Type de fichiers".
        .InitialView = msoFileDialogViewDetails 'Indique le type d'affichage dans la boîte de dialogue
        .Show
    End With
 
    Set objFichiers = Application.FileDialog(msoFileDialogOpen).SelectedItems 'Définit le ou les fichiers à ouvrir
    If objFichiers.Count = 0 Then Exit Sub 'On sort si aucun fichier n'a été sélectionné
 
    Application.StatusBar = "Ouverture Source"
 
    For x = 1 To objFichiers.Count    'Boucle sur le ou les fichiers Excel sélectionnés pour les ouvrir
        Set Wb = Workbooks.Open(objFichiers(x))
        Wb.Activate
        Set Source = Wb.Sheets("Format unique ITCE.rdl")
        DerligA = Source.[A65536].End(xlUp).Row 'mémorisation de la dernière ligne du FFU
 
        'Tri du FFU Source
        zonetri = "A2:CL" & DerligA
        Range(zonetri).Sort Range("D1"), xlAscending, Range("BF1"), , xlAscending 'Tri sur code Etat et Type ticket
 
        'positionnement sur le premier enregistrement Etat = Clos de la Source
        Recherche = "Clos"
        Searchrange = "D2:D" & DerligA
        ligneclos = Range(Searchrange).Find(Recherche).Row 'Recherche 1er clos
        ligneB = DerligB 'cible
 
        'Pour chaque ligne clos si les critères correspondent copie dans la cible
        For ligneA = ligneclos To DerligA
            If Source.Cells(ligneA, 4) = "Clos" Then
                If Source.Cells(ligneA, ColFFUTypeTicket) = "Incident fonctionnel" Then
                    If Source.Cells(ligneA, ColFFUEnvironnement) = "IP1" Or _
                        Source.Cells(ligneA, ColFFUEnvironnement) = "IP2" Or _
                        Source.Cells(ligneA, ColFFUEnvironnement) = "IP3" Or _
                        Source.Cells(ligneA, ColFFUEnvironnement) = "Production" Then
                            'Cible.Range(Cells(ligneB, 1), Cells(ligneB, 1)).Value = Source.Range(Cells(ligneA, 1), Cells(ligneA, DernièreColFFU)).Value 'copie source dans cible
                            colonne = 0
                            For colonne = 1 To DernièreColFFU
                                Cible.Cells(ligneB, colonne) = Source.Cells(ligneA, colonne)
                            Next
                            ligneB = ligneB + 1
                    End If
                End If
            Else
                Exit For
            End If
            Application.StatusBar = "A partir de " & ligneclos & " : " & ligneA & "/" & DerligA
        Next
 
        'Referme le classeur sans enregistrer les modifications.
        Wb.Close False
    Next
 
    MsgBox ("Terminé, dernière ligne lie = " & ligneA & ";  " & ligneB - 1 & " lignes copiées")
    Cible.Activate
End Sub