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

kikou017

XLDnaute Nouveau
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é.
 

Pièces jointes

  • Plans d'actions.xlsx
    15 KB · Affichages: 263

SWE

XLDnaute Nouveau
Merci beaucoup pour ton aide, cela m'a vraiment aidé. Du coup j'en ai profité pour également recopier le nom du client sur toutes les lignes concernées, et j'ai pris une partie seulement des données en faisant un delete + copy - paste de la partie droite du tableau.

Il me reste 2 dernières fonctions:
1 - rajouter des formules sur la première colonne, j'arrive bien à mettre la formule, mais il me colle un @ devant et du coup ça ne fonctionne pas :(

2 - je voudrais mettre une formule sur le total des lignes G et H

Et dernière question, j'aimerais pouvoir mettre à jour le texte qui se situera dans la colonne I (Actions), dans chaque case Actions correspondants à chaque onglet, par exemple en utilisant un autre bouton + macro associé. Je pense pouvoir entrevoir une solution, mais avant de me lancer, est-ce que c'est vraiment complexe à faire ?

Merci encore pour l'aide trés appréciable et la rapidité dont vous faites preuve !

En PJ le fichier, avec le code
 

Pièces jointes

  • SWE- test- v3.xlsm
    59.4 KB · Affichages: 6

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour SWE :),

1 - rajouter des formules sur la première colonne, j'arrive bien à mettre la formule, mais il me colle un @ devant et du coup ça ne fonctionne pas :(

2 - je voudrais mettre une formule sur le total des lignes G et H

Voir fichier joint...


Et dernière question, j'aimerais pouvoir mettre à jour le texte qui se situera dans la colonne I (Actions), dans chaque case Actions correspondants à chaque onglet, par exemple en utilisant un autre bouton + macro associé. Je pense pouvoir entrevoir une solution, mais avant de me lancer, est-ce que c'est vraiment complexe à faire ?

Pas compris la chose o_O
 

Pièces jointes

  • SWE- test- v3a.xlsm
    64.2 KB · Affichages: 6

SWE

XLDnaute Nouveau
Bonjour @mapomme , désolé pour le délai de retour j'étais en retraite d'internet pendant une semaine :p

Par contre, de ce que je comprends tu copie la formule dans chaque tableau, hors je pense qu'il est plus simple de déjà concaténer l'ensemble des données, et ensuite de copier la même formule dans toute la colonne concernée.

L'idée étant d'avoir un tableau avec une seule ligne d'en tête, et pas une ligne d'en-tête par client ;). Au vue de mon code, le plus simple serait peut être de supprimer l'ensemble de la feuille et de refaire la ligne d'en-tête à chaque mis à jour ?

Pour la dernière partie de mon message, la liste copiée dans l'onglet "Synthese" sert à faire une revue de projet, dans laquelle la colonne "Actions" sera modifié, l'idée est donc de remettre à jour chaque onglet client avec les derniers commentaires depuis l'onglet Synthese, ce qui permet donc de faire une MaJ dans les 2 sens (depuis l'onglet de chaque client et depuis l'onglet synthese).

Je continue de modifier mon code avec tous tes conseils, voici désormais la dernière version de mon code avec encore des erreurs du coup

VB:
Sub Synthese()
Dim xRg As Range, c As Range, xCopyTo As Range, sh As Worksheet, firstRow As Long, lastRow As Long, valeur As String

Sheets("Synthese").Range("A4:A" & Rows.Count).EntireRow.Delete

For Each sh In Worksheets
    With sh
        On Error Resume Next    ' si erreur (texte pas trouvé) dans la suite du code, on continue
        Set c = Nothing      'on remet c à nothing avant chaque recherche (indispensable)
        'On recherche le texte "Project name" dans la colonne A
        Set c = .Range("a:a").Find(What:="Project name", LookIn:=xlFormulas, LookAt:=xlWhole).Offset(1, 0) 'On ne copie que les données, pas la ligne d'en tête
        On Error GoTo 0      'on rétablit l'interception des erreurs
        If Not c Is Nothing Then    'si c est différent de nothing, c'est que la recherche a aboutit
            firstRow = c.Row     'première ligne
            lastRow = .Range("A" & Rows.Count).End(xlUp).Row    'dernière ligne
            Set xRg = .Range(.Cells(firstRow, "A"), .Cells(lastRow, "Q"))  'plage à considérer
            Set xCopyTo = Sheets("Synthese").Range("C" & Rows.Count).End(xlUp).Offset(1) 'Destination pour la copie
            xRg.Copy xCopyTo 'on copie xRg dans la destination
            'on copie le nom du client dans la colonne B
            xCopyTo.Offset(0, -1).Value = .Range("F1").Value 'Offset pour mettre les données les unes à la suite des autres
        End If
     End With
Next sh

For i = 4 To lastRow 'Recopie le nom du client dans chaque cellule vide
    If Cells(i, 2) <> "" Then
    valeur = Cells(i, 2).Value
    ElseIf Cells(i, 2) = "" Then
    Cells(i, 2).Value = valeur
    End If
Next i

Sheets("Synthese").Range("A4").Formula = "=VLOOKUP(B4,ACCUEIL!$A$1:$F$86,5)"
Sheets("Synthese").Range("A4").Select
Selection.AutoFill Destination:=Range(Cells(4, 1), Cells(lastRow, "A")) 'Copie la formule jusqu'à la dernière ligne du tableau

Sheets("Synthese").Columns("i:p").Delete 'Suppression des colonnes I à P
Sheets("Synthese").Columns.AutoFit


End Sub
 
Dernière édition:

SWE

XLDnaute Nouveau
Aprés quelques recherches et essais, j'ai donc rajouté en fin de boucle, la suppression des colonnes I à P, ensuite je rajoute les titres d'en tête manquants que je mets ensuite en forme.

Voici donc la dernière partie du code pour ce qui est de la présentation. Par contre celui-ci est conditionné au fait d'avoir déjà une lignes d'en-tête, en ligne 3, si celle-ci est vide, le code ne fait pas l'effet escompté

VB:
Sheets("Synthese").Range("A4").Formula = "=VLOOKUP(B4,ACCUEIL!$A$1:$F$86,5)"    'RechercheV en A4
Sheets("Synthese").Range("A4").Select
Selection.AutoFill Destination:=Range(Cells(4, 1), Cells(lastRow, "A")) 'On tire la formule jusqu'à la dernière ligne du tableau

Sheets("Synthese").Columns("i:p").Delete    'Suppression des colonnes I à P
Range("I3").Value = "Actions"
Range("J3").Value = "Date"
Range("K3").Value = "Project Status"
Range("A3").Copy
Set xRg = Range("I3:K3")
xRg.PasteSpecial Paste:=xlPasteFormats  'Copier-coller de la mise en forme de la cellule A3 sur les cellules I3 à K3

Columns("k:k").Select
Selection.ColumnWidth = 12
Columns("a:a").Select
Selection.ColumnWidth = 15
Sheets("Synthese").Columns.AutoFit
Sheets("Synthese").Rows.AutoFit
 

Discussions similaires

Statistiques des forums

Discussions
312 493
Messages
2 088 952
Membres
103 989
dernier inscrit
jralonso