[XL-2010] Copie de données variable

Bonjour,

Si j'ai bien compris ta demande tu souhaite consolider des données réparties dans différentes feuilles au sein d'une même feuille, le tout en tenant compte de critère situé dans des colonnes.

Pour répondre efficacement, une des solutions consiste a appliqué des filtres et copié les données visibles grâce à la méthode Specialcells de l'objet Range. Cela permet de gagner en temps de traitement surtout si tu as beaucoup de ligne à tester :)

Contrairement à ton code la première ligne (ligne des filtres) est fixé à 1 contre 26. Pour la modifier, c'est la constante FIRST_ROW.

N'hésite pas à te renseigner sur la méthode PasteSpecial qui permet d'avoir accès aux différents types de collage.

Code:

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
Option Explicit
'*******************************************************************************************************
' NAME : SpecCopy (PROCESS)
' DESCRIPTION : La procédure permet de consolider des données à partir de multiple feuille vers une
' feuille de synthèse
'*******************************************************************************************************
Public Sub SpecCopy()
 
    Const NAME_SYNTHESE As String = "FIN EXERCICE"  ' Nom de la feuille de synthèse
    Const FIRST_ROW     As Integer = 1              ' Numéro de la première ligne des feuilles de données
    Const LAST_COLUMN   As Integer = 20             ' Numéro de la dernière colonne à exporter
 
    Dim oRangeData As Excel.Range                   ' Cellule comprenant les éléments de critère
    Dim oSheetData As Excel.Worksheet               ' Feuille contenant les données à copier
    Dim oWorksheet As Excel.Worksheet               ' Feuille de synthèse ("FIN EXERCICE")
    Dim iLastRow   As Long
 
    Application.ScreenUpdating = False              ' Désactivation du rafraichissement de l'écran
 
    'Fixer la feuille de synthèse par son nom
    Set oWorksheet = ThisWorkbook.Worksheets("FIN EXERCICE")
 
    With oWorksheet
        ' Suppression des données précédentes (a desactiver si besion)
        iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Rows("2:" & iLastRow + 1).Delete
    End With
 
    ' Boucle sur toutes les feuilles du classeurs
    On Error Resume Next
    For Each oSheetData In ThisWorkbook.Worksheets
 
        ' Rajouter des noms pour exclures des feuilles
        ' RECAPITULATIF & MARCHES
        If oSheetData.Name <> NAME_SYNTHESE And oSheetData.Name <> "RECAPITULATIF" Then
 
            With oSheetData
 
                If .FilterMode Then
                    .ShowAllData 'Affichage des données masquées
                End If
 
                ' dernière ligne à partir de la colonne du critère 1
                iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
 
                'Fixe de la plage
                Set oRangeData = .Range(.Cells(FIRST_ROW, 1), .Cells(iLastRow, LAST_COLUMN))
 
                'Application des filtres sur les données (2 = colonne B & 20 = colonne T)
                oRangeData.AutoFilter 2, "<>" 'Filtre pour différent du vide
                oRangeData.AutoFilter 20, "=" 'Filtre pour = au vide
 
                ' Copie des cellules répondant aux critères
                oRangeData.Offset(1).SpecialCells(xlCellTypeVisible).Copy
 
            End With
 
             With oWorksheet
 
                iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
 
                ' La méthode pastespecial permet d'avoir accès au diffétent type
                ' de copie que propose excel (Ex : Coller les valeurs)
                .Range("A" & iLastRow + 1).PasteSpecial xlPasteValues
 
            End With
 
            oSheetData.ShowAllData
 
        End If
 
    Next oSheetData
 
    Application.ScreenUpdating = True
 
End Sub

Voici le fichier avec les tests
Pièce jointe 430478

En espérant avoir répondu à tes attentes.
A+