Copie de plusieurs onglets vers un seul

**sebizar** · 22/06/2012, 23h37

Bonjour à tous,

je sais que la question a déja été quelque fois posée mais après avoir essayé de récupérer les solutions proposées ici ou sur d'autres forum, je sèche...

Je vous expose mon pb :

J'ai plusieurs onglets dont le nombre de colonnes est fixe. Les entêtes de colonnes sont identiques, mais le nombre de lignes est variable.

J'aimerai que ma macro puisse récupérer le contenu du tableau de chaque onglet (sans copier la première ligne qui est à chaque fois la ligne des intitulés de colonne) et le copier/compiler à la suite dans un onglet synthèse.

Merci d'avance pour votre aide !

**kiki29** · 23/06/2012, 00h43

Salut, à adapter à ton contexte.Comme il y a une macro il faudra sauver ton fichier en xlsm ou xlsb.

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
Option Explicit
 
Sub ConcatenationFeuilles()
Dim i As Long, T() As Variant
 
    Application.ScreenUpdating = False
    ShConcat.Cells.Clear
 
    ' Copie En-Tête
    ' Au cas ou la feuille de synthèse se trouverait en 1ere position
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> ShConcat.Name Then
            With Worksheets(i)
                T = .Range("A1:P1").Value
                ShConcat.Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
            Exit For
        End If
    Next i
 
    '   Copie des données
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> ShConcat.Name Then
            With Worksheets(i)
                T = .Range("A2:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value
                ShConcat.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
        End If
    Next i
    Erase T
    Application.ScreenUpdating = True
End Sub

ShConcat étant le CodeName de la feuille "synthèse"
Pour le CodeName voir ici
Les avantages du CodeName étant que l'utilisateur peut changer le nom d'onglet des feuilles, ajouter des feuilles ou en déplacer sans avoir à retoucher au code VBA.

**Bear the french** · 23/06/2012, 01h05

Bonsoir sebizar,

Je te propose un code beaucoup plus long que celui de kiki29.
Plus long mais je le comprend bien

L'objectif, créer un onglet "TOTAL" (ou synthèse si tu veux l'adapter) :

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
Sub faitotalonglet()
'---------------------------------------------------------------------------------------
'Macro qui copie toutes les lignes (hormis les intitulés de colonne) de tous les onglets
'et créer un nouvel onglet "TOTAL" composé de l'ensemble des lignes
'---------------------------------------------------------------------------------------
 
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim t(16) As String
 
    'Initialisation des intitulés de colonne
    t(1) = "CSP"
    t(2) = "N° Formation"
    t(3) = "Intitulé1"
    t(4) = "Intitulé2"
    t(5) = "Objectifs1"
    t(6) = "Objectifs2"
    t(7) = "Moyen_evaluation1"
    t(8) = "Moyen_evaluation2"
    t(9) = "Organisme1"
    t(10) = "Organisme2"
    t(11) = "Début_session1"
    t(12) = "Début_session2"
    t(13) = "Statut"
    t(14) = "Catégorie"
    t(15) = "Nom"
    t(16) = "Prénom"
 
    'Création d'un nouvel onglet TOTAL
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "TOTAL"
 
    'chargement des intitulés de colonne
    For i = 1 To 16
        Cells(1, i).Value = t(i)
    Next
 
    'Mise en forme des intitulés
    Range("A1:P1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlCenter
    End With
 
    'Parcours la collection en évitant la feuille "TOTAL"
    For Each Fe In ThisWorkbook.Worksheets
 
        If Fe.Name <> "TOTAL" Then
 
            With Fe
                'définie la plage sans la ligne de titres
               Set Plage = .Range(.Cells(2, 1), .Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, .Cells.Find("*", .[A1], -4123, , 2, 2).Column))
            End With
 
            'colle les valeurs dans la feuille "TOTAL"
            'après la dernière ligne non vide
            Plage.Copy Worksheets("TOTAL").Range("A65500").End(xlUp).Offset(1, 0)
 
        End If
 
    Next Fe
 
End Sub

Bertrand

**kiki29** · 23/06/2012, 03h43

Salut Bertrand , non seulement plus long mais aussi plus lent

**Bear the french** · 23/06/2012, 07h48

Bonjour Kiki29,

Oui, mon algorithme fonctionne, c'est pour l'instant suffisant pour moi qui apprend à pratiquer le vba en autodidacte

En terme d'efficacité, je suis bien certain que le tien doit être plus rapide

Bertrand

Bonsoir Kiki29,

Ton code post #2 retient en T le nombre de lignes calculées sur la base de la colonne A. Hors la colonne A peut avoir des zones avec une ou plusieurs cellules vides. Dans la même idée, la colonne A peut être plus "courte" que les autres (courte = avec moins de lignes).

Mes tests (peut-être que j'ai mal adapté ton code

) me semble me donner raison sur ce point. Est correct de dire que la colonne A ne doit pas avoir de cellule vide pour fonctionner et doit être la colonne la plus grande de toute en nombre d'éléments ?

Bertrand