Discussion :

[GG-42]

Bonjour à tous
Je suis débutant en vba et mon problème est le suivant :
je souhaite copier des plages précises et identiques de plusieurs onglets dans un autre onglet synthese où ces plages ne formeront plus qu'une seule liste de données.
Remarque 1 : Je ne souhaite pas copier l'intégralité du contenu de chaque onglet, seulement une plage bien précise à chaque fois.
Remarque 2: Le nombre d'onglets peut varier
Remarque 3 : l'onglet synthese n'est pas situé en derniere position dans la suite des onglets
Je vous remercie d'avance pour votre précieuse aide!
GG

[Invité]

Bonjour,

Ci-joint, une solution dans le fichier joint qui comporte 1 feuille synthèse, 1 feuille paramètres, 5 feuilles de données dont 3 seront concernées par la copie. La feuille Synthèse est la 3ème dans l'ordre des feuilles et sa position n'a pas d'incidence sur le programme.


Les feuilles dont les données doivent être récupérées, sont inscrites dans la feuille paramètres. L'ordre des feuilles sera celui affiché dans la feuille synthèse par la suite.
L'aire des données à copier est inscrite dans la zone nommée "AdresseDonneesACopier".http://www.developpez.net/forums/att...1&d=1371097938

Les résultats sont recueillis à partir de la ligne 11 dans la feuille synthèse. La première colonne indique la feuille d'origine des données.
A chaque lancement de la macro CopierLesDonneesDansSynthese, le tableau existant est effacé. http://www.developpez.net/forums/att...1&d=1371097938

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
Option Explicit
 
Private ShSynthese As Worksheet
Private ShParametres As Worksheet
 
Private AireACopier As Range
Private FeuillesACopier As Range
Private CelluleFeuilles As Range
 
Private AdresseDonnees As String
 
Private LigneDeTitreSynthese As Long
Private DerniereLigneSynthese As Long
Private PremiereColonneSynthese As Long
Private LigneDebutSynthese As Long
Private ColonneFeuillesAIncorporer As Long
 
Private LigneDeTitreParametres As Long
Private DerniereLigneParametres As Long
 
 
 
 
 
Sub CopierLesDonneesDansSynthese()
 
    Application.ScreenUpdating = False
 
    Set ShSynthese = Sheets("Synthèse")
    LigneDeTitreSynthese = 10
    PremiereColonneSynthese = 2
 
    ' Effacement de la feuille synthèse
    ShSynthese.Range(ShSynthese.Cells(LigneDeTitreSynthese + 1, 1), ShSynthese.Cells(ShSynthese.Rows.Count, ShSynthese.Columns.Count)).ClearContents
    DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row
 
    Set ShParametres = Sheets("Paramètres")
 
    ' Chargement de la liste des feuilles à incorporer et de l'adresse de l'aire à copier
    AdresseDonnees = ShParametres.Range("AdresseDonneesACopier")
    LigneDeTitreParametres = 10
    ColonneFeuillesAIncorporer = 1
    DerniereLigneParametres = ShParametres.Cells(ShParametres.Rows.Count, ColonneFeuillesAIncorporer).End(xlUp).Row
 
    Set FeuillesACopier = ShParametres.Range(ShParametres.Cells(LigneDeTitreParametres + 1, ColonneFeuillesAIncorporer), ShParametres.Cells(DerniereLigneParametres, ColonneFeuillesAIncorporer))
 
 
    For Each CelluleFeuilles In FeuillesACopier
 
        Set AireACopier = Sheets(CelluleFeuilles.Value).Range(ShParametres.Range("AdresseDonneesACopier"))
 
        With ShSynthese
            LigneDebutSynthese = DerniereLigneSynthese
            AireACopier.Copy
            .Cells(DerniereLigneSynthese + 1, PremiereColonneSynthese).Select
            ShSynthese.Paste
            DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row
            .Range(ShSynthese.Cells(LigneDebutSynthese + 1, 1), ShSynthese.Cells(DerniereLigneSynthese, 1)) = CelluleFeuilles
        End With
 
        Set AireACopier = Nothing
 
    Next CelluleFeuilles
 
    ShSynthese.Cells(LigneDeTitreSynthese, 1).Activate
 
    Set ShParametres = Nothing
    Set ShSynthese = Nothing
 
    Application.ScreenUpdating = True
 
 
End Sub

Cordialement.

[GG-42]

Bonjour Eric
Merci pour la réponse tres rapide et complète;
Par rapport au fonctionnement de la macro et au résultat final j'aurais plusieurs demandes / observations complémentaires :
1. ds l'onglet synthese je ne souhaite pas afficher en colonne A la feuille source

2. Je ne souhaite pas non plus lister dans un onglet parametre les noms des feuilles

(raison : je souhaite que le sutilisateurs finaux ne voient que les informations qui les concernent et ne puissnet pas toucher au parametrage) - en navigunat sur le web j'ai vu des propositions de macro qui me satisfont au niveau de la gestion des onglets, mais le probleme est que tout le contenu de la feuille est copié collé.
(désolé de citer un autre forum
3. Je souhaite copier une partie de tableau de chaque onglet dans l'onglet synthese (dans ton example les plages ("c2:e9") de chaque onglet dans l'onglet synthese).
Merci beaucoup pour l'aide

[Invité]

Point 1 : OK
Point 2 : Cela veut-il dire que la liste des onglets est codée en dur ?
Point 3 : C'est ce que la macro fait, puisque les données à récupérer sont réglables dans la feuille Paramètres. Sur ce point, comment sont définies les zones si la feuille paramètre ne doit plus exister ? La feuille paramètre continue-t-elle d'exister mais elle est cachée ?

Cordialement.

[GG-42]

Eric
concernant le point 2 : j'ai un code qui permet d'utiliser les différents n onglets d'un fichier sans avoir à les lister ds un onglet à part, cf code plus loin; par contre ce code copie l'intégralité de chaque feuille, alors que moi je ne veux copier comme déjà dit et comme tu l'as fait ds ta macro qu'une certaine plage...
Merci pour ton aide

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
Dim Fe As Worksheet
    Dim Plage As Range
 
    'parcour la collection en évitant kla feuille
   'de consolidation
   For Each Fe In ThisWorkbook.Worksheets
 
        If Fe.Name <> "CONSO" 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 de consolidation
   'après la dernière ligne non vide
           Plage.Copy _
            Worksheets("CONSO").Range("A65536").End(xlUp).Offset(1, 0)
 
        End If
 
    Next Fe
 
End Sub

[Invité]

Le code modifié :

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
Sub CopierLesDonneesDansSynthese()
 
Dim ShSynthese As Worksheet
Dim Sh As Worksheet
Dim ShEnCours As Worksheet
 
Dim AireACopier As Range
 
Dim LigneDeTitreSynthese As Long
Dim DerniereLigneSynthese As Long
Dim PremiereColonneSynthese As Long
Dim LigneDebutSynthese As Long
 
 
 
    Application.ScreenUpdating = False
 
    Set ShSynthese = Sheets("Synthèse")
    LigneDeTitreSynthese = 10
    PremiereColonneSynthese = 1
 
    ' Effacement de la feuille synthèse
    ShSynthese.Range(ShSynthese.Cells(LigneDeTitreSynthese + 1, 1), ShSynthese.Cells(ShSynthese.Rows.Count, ShSynthese.Columns.Count)).ClearContents
    DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row
 
    For Each Sh In Worksheets
 
        If Sh.Name <> "Synthèse" Then
           Set ShEnCours = Sheets(Sh.Name)
 
           Set AireACopier = ShEnCours.Range("B20:E30")
 
           With ShSynthese
                LigneDebutSynthese = DerniereLigneSynthese
                AireACopier.Copy
                .Cells(DerniereLigneSynthese + 1, PremiereColonneSynthese).Select
                ShSynthese.Paste
                DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row
           End With
 
           Set AireACopier = Nothing
           Set ShEnCours = Nothing
 
       End If
 
    Next Sh
 
    ShSynthese.Cells(LigneDeTitreSynthese, 1).Activate
    Set ShSynthese = Nothing
    Application.ScreenUpdating = True
 
 
End Sub

Le fichier contient également l'ancienne méthode.


Cordialement.

[GG-42]

Merci beaucoup Eric, la macro effectue exactement ce que je souhaite faire! ton intervention me fait économiser beaucoup d'heures de tatonnements et d'itérations.

...J'ai une derniere demande : je veux pouvoir modifier dans la macro le numéro de la ligne ou début la synthese (actuellement la restitution démarre sur la deuxieme ligne de la feuille synthese, dans la cellule A2); je souhaiterais par exemple faire débuter la restitution dans la cellule j5 de l'onglet synthese (j'arrive a parametrer ds ta macro la 10eme colonne ("j")mais je n'arrive pas a paraméter la 5eme ligne ("5")...

Encore merci beaucoup pour ton aide

Eric,
j'ai trouvé tout seul comme un grand garçon la odification à effectuer pour changer le numéro de ligne de début de restitution ds 'onglet synthese je rajouter par exemple "+5" à la fin de

Code :

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

1
2
3
 ' Effacement de la feuille synthèse
    ShSynthese.Range(ShSynthese.Cells(LigneDeTitreSynthese + 1, 1), ShSynthese.Cells(ShSynthese.Rows.Count, ShSynthese.Columns.Count)).ClearContents
    DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row

Vraiment merci beaucoup pour ton aide

[GG-42]

Bonjour
dans la macro précédemment citée je souhaite remplacer le collage simple des données de chaque onglet par un collage spécial valeur (car les données de départ sont issues de formules)
Je souhaite donc remplacer la ligne de code A ci-dessous par une ligne de code B (voir plus bas également) qui utilisierait la fonction "collage spécial"; je tourne en rond avec la formule de puis un moment,....
Merci pour votre aide

ligne A (qui fonctionne tres bien) :

Code :

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

1
2
3
4
 AireACopier.Copy
                .Cells(DerniereLigneSynthese + 1, PremiereColonneSynthese).Select
                ShSynthese.Paste
                DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row

ligne B :

Code :

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

1
2
3
4
AireACopier.Copy
                .Cells(DerniereLigneSynthese + 1, PremiereColonneSynthese).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row

Merci

[Invité]

Bonjour,

Il faut remplacer

Code :

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

ShSynthese.Paste

Par

Code :

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

 .Cells(DerniereLigneSynthese + 1, PremiereColonneSynthese).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Car le collage spécial s'applique à l'objet range dans ce cas.

Cordialement.

[GG-42]

Merci beaucoup, j'étais tres loin de la solution!

[Philippe Tulliez]

Bonjour,
J'arrive un peu comme les cavaliers d'Offenbach et je n'ai pas regardé la solution proposée par Eric mais comme le sujet correspond à une de mes contributions, voici tout de même le lien Regrouper plusieurs feuilles sur une autre. (2003-2010).
Explication complète du code + classeur démo à télécharger

[olivier.perret]