Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

[kikou017]

Bonjour,

J'ai pas mal parcouru les pages de ce forum, très bien fait d'ailleurs, et j'ai trouvé en partie ma réponse mais pas complètement, d'où mon post.
Ce que je souhaite faire :
J'ai créé un classeur avec plusieurs onglets. Chacun contient un tableau construit selon la même structure.
Je voudrais pouvoir créer une synthèse de tous les onglets dans un onglet 'synthèse'.
Le nombre d'onglets du classeur est variable (ajout régulier d'onglets).
Il s'agit en fait de plans d'actions. Chaque onglet est propre à un projet et la synthèse me donnerait la liste de toutes les actions de tous les projets (le nombre d'onglets augmente avec le nombre de projets à suivre).
Pourriez vous m'aider à réaliser cette synthèse ?

D'avance merci,

PS : Je vous joins le fichier concerné.

 

[mapomme]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonsoir kikou017 et bienvenu

Voir un essai dans le fichier joint.

Sub Synthese()
Dim xRg As Range, xCopyTo As Range, sh As Worksheet

Sheets("Synthèse").Range("A4:A" & Rows.Count).EntireRow.Delete

For Each sh In Worksheets
  If sh.Name <> "Synthèse" Then
    With sh
      Set xRg = .Range("D" & Rows.Count).End(xlUp)
      If xRg.Row > 3 Then
        Set xCopyTo = Sheets("Synthèse").Range("D" & Rows.Count).End(xlUp).Offset(1)
        .Range("A4:K" & xRg.Row).Copy xCopyTo.Offset(, -3)
      End If
    End With
  End If
Next sh

End Sub

 

[kikou017]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonsoir mapomme,

Merci beaucoup, cela fonctionne à merveille et répond en tous points à ce que je recherchais !
Juste pour ma culture personnelle, peux tu m'expliquer les grandes lignes du code en question ? Ca me permettra éventuellement de le modifier au besoin.
Dernière question, comment "exporter" la macro et le bouton dans un autre fichier ?

Merci encore,

 

[mapomme]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

(re)Bonsoir kikou017

peux tu m'expliquer les grandes lignes du code en question ? ... Dernière question, comment "exporter" la macro et le bouton dans un autre fichier ?

Sub Synthese()
Dim xRg As Range, xCopyTo As Range, sh As Worksheet

' On efface les précédents résultats de la feuille synthèse tout en gardant la ligne 3 (ligne des en-têtes)
' on supprime toutes les lignes de la ligne 4 jusqu'à la dernière ligne de la feuille.
' Rows.count renvoie le nombre total de lignes d'une feuille de calcul.

Sheets("Synthèse").Range("A4:A" & Rows.Count).EntireRow.Delete

' on boucle sur toutes les feuilles de calculs du classeur
For Each sh In Worksheets
' on verifie que la feuille à traiter sh n'est pas la feuille synthèse
If sh.Name <> "Synthèse" Then
' si la feuille n'est pas la feuille synthèse alors on va travailler avec la feuille sh
With sh
' on recherche la dernière cellule non vide de la colonne D (intitulé)
' le point de .range remplace l'écriture sh.range (car on a utilisé l'instruction with sh)
Set xRg = .Range("D" & Rows.Count).End(xlUp)

' le n° de la première ligne de xRg est xRg.row.
' Si ce numéro de ligne est inf ou égal à 3, cela signifie
' que la colonne D ne contient aucun intitulé => donc on ne fera rien.
If xRg.Row > 3 Then

' on détermine vers où copier dans la feuille synthèse.
' pour cela, on recherche la dernière cellule non vide de la colonne D puis on descend
' d'une ligne (.offset(1)) qui correspond à la 1ere cellule vide de la colonne D après
' les précédentes données déjà copiées sur la feuille synthèse.
Set xCopyTo = Sheets("Synthèse").Range("D" & Rows.Count).End(xlUp).Offset(1)

' on copie les données de sh dans le tableau de synthèse
' les cellules à copier commencent à la cellule A4 et se termine en Kn
' avec N le numéro de ligne de la dernière cellule de la colonne D
' Mais où copier ?
' on copie sur la ligne de xCopyTo. Mais comme xCopyTo correspond à la colonne D
' et qu'on veut copier en colonne A, il faut translater xCopyTo de 3 colonnes vers la gauche
' (de D vers A) c'est le rôle de .offset(,-3)
.Range("A4:K" & xRg.Row).Copy xCopyTffset(, -3)

End If
End With
End If
Next sh

End Sub


Copier le module d'un classeur vers un autre:

• Ouvrir le classeur où se trouve la macro à copier
• Passer en mode editeur VBA par les touches Alt+F11
• Sur la droite se trouve la fenêtre "explorateur de projet" (si elle n'y est pas, faites la apparaître par les touches Ctrl+R)
• Repérer le projet qui porte le nom du classeur actif
• au sein de ce projet, développer le "répertoiré Modules
• cliquer droit sur module1 et sélectionner exporter un fichier...
• sauvegarder le module sur votre disque
• fermer votre fichier
• Ouvrir le classeur où insérer la macro.
• Passer en mode editeur VBA par les touches Alt+F11
• Sur la droite se trouve la fenêtre "explorateur de projet" (si elle n'y est pas, faites la apparaître par les touches Ctrl+R)
• Repérer le projet qui porte le nom du classeur actif
• cliquer droit sur Modules et sélectionner Importer un fichier...
• Aller chercher le fichier précédemment sauvegardé.

Pour le bouton:

Ce n'est pas un bouton mais une forme à laquelle on a affecté une macro.

• Insérer une forme quelconque (menu Insertion/Forme)
• cliquer droit sur la forme et sélectionner Affecter une macro...
• sélectionner dans zone Macro dans la valeur ce classeur
• sélectionner la macro synthese()

 

[kikou017]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonjour,
Merci encore.
J'ai une dernière question suite aux explications.
Maintenant que ce que je voulais faire fonctionne très bien, je me suis dit que j'allais essayer de peaufiner (dans un 2ème temps, j'essaierai de faire des synthèses selon que l'action est terminée ou en cours).
J'ai donc essayé, pour rendre la synthèse plus lisible, de faire une différence dans le tableau final entre les différents projets. J'avais d'abord pensé à une mise en forme conditionnelle mais j'ai abandonné.
Suite aux explications, je me suis dit que j'allais remplacer "Set xCopyTo = Sheets("Synthèse").Range("D" & Rows.Count).End(xlUp).Offset(1)" par "Set xCopyTo = Sheets("Synthèse").Range("D" & Rows.Count).End(xlUp).Offset(2)" afin d'ajouter une ligne vide entre 2 projets.
Ca marche très bien sauf que ce que je ne comprends pas, c'est pourquoi cela me place également une ligne blanche au début (ligne 4 dans l'exemple) ? (et empêche ainsi le filtre automatique). Vu que l'on copie toutes les cellules non vides de chaque onglet + la première ligne vide et que l'on colle tout à partir de A4, je ne comprends pas pourquoi la première ligne est vide.
Je ne sais pas si mes explications sont très compréhensibles, quoi qu'il en soit, c'est vraiment du pinaillage !
Bonne soirée,

 

[mapomme]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonsoir kikou017,

Ca marche très bien sauf que ce que je ne comprends pas, c'est pourquoi cela me place également une ligne blanche au début (ligne 4 dans l'exemple) ? (et empêche ainsi le filtre automatique). Vu que l'on copie toutes les cellules non vides de chaque onglet + la première ligne vide et que l'on colle tout à partir de A4, je ne comprends pas pourquoi la première ligne est vide.

La boucle effectue les mêmes instructions qu'elle soit en train de traiter le premier tableau, le second tableau ou les suivants.
Donc, si on intercale une ligne vide à chaque copie, on le fera aussi pour le la copie du premier tableau. C'est pourquoi il y a une ligne vide en ligne 4 de la synthèse.
Le code de la v2, fait un test du n° de ligne de Synthèse où on devrait copier le tableau projet. Si ce numéro de ligne est égal à 4, alors on fait la copie du premier tableau de projet et on n'intercale pas de ligne vide sinon on insère une ligne vide (j'en ai profité pour colorer la ligne vide insérée)

une ligne blanche au début (ligne 4 dans l'exemple) ? (et empêche ainsi le filtre automatique)

Vrai mais c'est aussi le cas pour toutes les autres lignes vides de séparation des projets; à moins de sélectionner d'abord tout le tableau (de la ligne n°3 des en-têtes jusqu'à la dernière ligne non vide de synthèse) puis d'appliquer le filtre auto.

C'est ce que fait la macro Sub FiltreAuto() associé à la forme "Filtrer -/-"

Sub Synthese()
Dim xRg As Range, xCopyTo As Range, sh As Worksheet

Sheets("Synthèse").Range("A4:A" & Rows.Count).EntireRow.Delete
'On enlève le filtre auto s'il y en a un
If Sheets("Synthèse").AutoFilterMode Then Sheets("Synthèse").AutoFilterMode = False
For Each sh In Worksheets
  If sh.Name <> "Synthèse" Then
    With sh
      Set xRg = .Range("D" & Rows.Count).End(xlUp)
      If xRg.Row > 3 Then
        Set xCopyTo = Sheets("Synthèse").Range("D" & Rows.Count).End(xlUp).Offset(1)
        ' Si le n° de ligne où copier est égal à 4, cela signifie qu'on effectue la copie
        ' d'un premier tableau de projet. Dans ce cas, on n'insère pas de ligne supplémentaire.
        ' Si le n° de ligne où copier est sup. à 4, cela signifie qu'on effectue la copie
        ' d'un second (ou plus) tableau de projet. Dans ce cas, on grise la ligne
        ' puis on décale xCopyTo d'une ligne et on y fait la copie.
        If xCopyTo.Row <> 4 Then
          ' la ligne insérée vide prend la couleur de l'en-tête
          Sheets("Synthèse").Range("B" & xCopyTo.Row & ":K" & xCopyTo.Row).Interior.Color = _
            Sheets("Synthèse").Range("B3").Interior.Color
          ' on décale xCopyTo d'une ligne vers le bas pour y faire la copie
          Set xCopyTo = xCopyTo.Offset(1)
        End If
          ' on fait la copie
          .Range("A4:K" & xRg.Row).Copy xCopyTo.Offset(, -3)
      End If
    End With
  End If
Next sh

End Sub

Sub FiltreAuto()
Dim maZone As Range

' si la feuille est en mode autofiltrée, on efface le filtre auto
  If Sheets("Synthèse").AutoFilterMode Then
    ' si la feuille est en mode autofiltrée, on efface le filtre auto
    Sheets("Synthèse").AutoFilterMode = False
  Else
    ' si la feuille n'est pas en mode autofiltrée:
    ' on définit la zone à filtrer
    Set maZone = Sheets("Synthèse").Range("D" & Rows.Count).End(xlUp)
    ' on filtre auto la zone
    Sheets("Synthèse").Range("A3:K" & maZone.Row).AutoFilter
  End If
End Sub

 

[kikou017]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonsoir,

Je pense que nous frôlons maintenant la perfection !!
Merci beaucoup mapomme pour ton aide, tes explications, et ta gentillesse.

On se recroisera peut être sur ces forums que je vais conserver en favori (je vais essayer de me mettre un peu à la programmation vba).

A bientôt,

 

[JBV010912]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonjour,

Merci pour cette discussion et ce code très utile.
Je suis en train d'essayer de le décliner pour mon propre projet. Le fichier est très similaire au fichier initial. Cependant je souhaiterais que la synthèse finale copie seulement les valeurs (j'utilise en effet des formules qui s'altèrent si elles sont transposées dans un autre onglet). Comment puis modifier le code pour qu'il me concatène seulement les valeurs?
En vous remerciant par avance,

Précisions je suis sous Windows et j'utilise Excel 2010.

 

[mapomme]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonne année JBV010912,

(...) je souhaiterais que la synthèse finale copie seulement les valeurs (...) Comment puis modifier le code pour qu'il me concatène seulement les valeurs? (...)

Voir le code de la version v3. Le code (pour copier) de la v2 :

.Range("A4:K" & xRg.Row).Copy xCopyTo.Offset(, -3)

a été remplacé par celui de la v3 :

          .Range("A4:K" & xRg.Row).Copy
          ' on fait le collage en valeur
          xCopyTo.Offset(, -3).PasteSpecial xlPasteValues
          ' on fait le collage en format
          xCopyTo.Offset(, -3).PasteSpecial xlPasteFormats
          ' on libère le presse papier
          Application.CutCopyMode = False

qui colle les valeurs puis colle les formats.

Si seules les valeurs vous intéressent, alors effacer la ligne de code de collage des formats.

 

[JBV010912]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Merci et bonne année à vous !

Cela fonctionne très bien sauf pour une des colonnes.
En fait, dans les tableaux que j'importe en synthèse, il y a une colonne qui prend le nom de la feuille (=GAUCHE(DROITE(STXT(CELLULE("nomfichier");TROUVE("]";CELLULE("nomfichier"))+1;30);20);20)). Avec le code en l'état, il me met "Synthèse" (i.e. le nom de la feuille où on récupère tout) alors que j'aimerais garder le nom de la feuille d'origine des informations.

Sauriez-vous comment solutionner cela ?

En vous remerciant sincèrement pour votre aide.

 

[mapomme]

Re : Concatener des tableaux présents dans plusieurs onglets dans un tableau unique

Bonsoir JBV010912,

(...) Cela fonctionne très bien sauf pour une des colonnes.
En fait, dans les tableaux que j'importe en synthèse, il y a une colonne qui prend le nom de la feuille (=GAUCHE(DROITE(STXT(CELLULE("nomfichier");TROUVE("]";CELLULE("nomfichier"))+1;30);20);20)). Avec le code en l'état, il me met "Synthèse" (i.e. le nom de la feuille où on récupère tout) alors que j'aimerais garder le nom de la feuille d'origine des informations. (...)

J'ai mis votre formule dans la colonne I des tableaux à recopier. Vous remarquerez que quand on change de feuille Projet , la formule ne se met pas à jour non plus. Cela vient du comportement de la fonction CELLULE. Pour forcer la formule à se mettre à jour, il suffit de tapez la touche de fonction F9 qui force le re-calcul. Dans le code VBA, nous allons procéder de même.

Avant la copie d'un tableau, nous allons sélectionner la feuille du tableau et recalculer la feuille pour forcer la mise à jour de la formule.

La ligne de copie du tableau de la version v3:

.Range("A4:K" & xRg.Row).Copy

est précédée dans la version v4 des instructions de sélection de la feuille et de calcul de la feuille:

          .Activate: .Calculate
          .Range("A4:K" & xRg.Row).Copy

Autre méthode (ma préférée ) :

Remplacer dans votre formule : CELLULE("nomfichier") par : CELLULE("nomfichier"; I1)
En indiquant la référence I1 (ou n’importe quelle cellule de la même feuille que la formule), le retour de la formule sera toujours exact ==> version 3a (formule modifiée et code de la version v3)

 

[SWE]

Bonjour,

Tout d'abord merci pour l'aide apportée qui est très précieuse. J'ai la même problématique que kikou017, à la différence prés que le début de ma plage de sélection pour chaque onglet est également variable. Chaque onglet est composé de 2 "parties", la première de la ligne 1 à X (X étant variable), que je ne souhaite pas garder, et ensuite la seconde partie de la ligne X+1 à la ligne Y (Y étant la dernière ligne non vide). Les colonnes sont fixes et vont de A à R.

J'avais tout d'abord pensé à changer le code original en indiquant une valeur de sélection à la variable xRg, en indiquant le N° de la ligne correspondant à mon début de 2ème zone (débutant à la ligne où se trouve "Project Name" dans la colonne A)

Dim c As Object, r1 As Integer, lastrow As Range, lastcolumn As Integer
Set c = Worksheets(sh).Range("A1").Find("Project name")
r1 = c.Row
Set lastrow = .Range("A" & Rows.Count).End(xlUp)
Set xRg = .Range(Cells(r1, "A"), Cells(lastrow, "R"))

Cependant cette méthode ne fonctionne pas et je n'arrive pas à comprendre pourquoi...

Merci par avance pour votre aide

 

[mapomme]

Bonsoir SWE,

Dans votre code, plusieurs petites choses ne vont pas:

• Vous avez déclaré des variables avec un certain type (c'est bien ) mais dans la suite du code, vous les utilisez comme un autre type (Lastrow est un range et Cells voudrait en premier paramètre une valeur de type long qui représente un numéro de ligne et pas un range). Vous auriez pu utiliser Cells(Lastrow.Row qui retourne le numéro de la première ligne d'un range)
• Vous ne cherchez pas la valeur "Project name" dans la colonne A mais seulement dans la cellule A1
• Vous n'envisagez pas le cas où la valeur "Project name" n'existe pas

Voyez le fichier joint avec son code (c'est juste un exemple à ma sauce). Le code est dans le module de Feuil1.

 

[SWE]

Merci beaucoup pour cette première réponse, effectivement beaucoup d'erreurs de ma part, notamment car je suis novice et donc principalement du "copier-coller" de code trouvé à droite à gauche sans réel logique informatique

Grâce à votre aide, j'ai réussi à faire un copier-coller de la zone souhaitée, cependant je n'arrive pas à reproduire l'itération pour chaque onglet. En effet, si je lance la macro depuis l'onglet, alors la copie se fait bien, par contre si je lance la macro depuis la page de synthese, il copie uniquement l'onglet actif. L'erreur doit être sous mon nez mais je ne la vois pas :s

De plus, il faudrait que pour chaque ligne copiée, je puisse reporter le nom du client associé

Avec le fichier en PJ cela sera plus simple je suppose

 

[mapomme]

Bonjour SWE ,

cependant je n'arrive pas à reproduire l'itération pour chaque onglet. En effet, si je lance la macro depuis l'onglet, alors la copie se fait bien, par contre si je lance la macro depuis la page de synthese, il copie uniquement l'onglet actif. L'erreur doit être sous mon nez mais je ne la vois pas

Voir le code du fichier. Il est commenté.

De plus, il faudrait que pour chaque ligne copiée, je puisse reporter le nom du client associé

On met le nom du client juste au-dessus de chaque tableau (pour cela, on colle chaque tableau 3 lignes plus bas que le précédent)

effectivement beaucoup d'erreurs de ma part, notamment car je suis novice et donc principalement du "copier-coller" de code trouvé à droite à gauche sans réel logique informatique

Il faut bien commencer par quelque chose. Petit à petit, ça viendra. Et puis XLD est là .